!------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ||===\\ | ! || \\ | ! || || //==\\ || || //==|| ||/==\\ | ! || || || || || || || || || || | ! || // || || || || || || || | ! ||===// \\==// \\==\\ \\==\\ || | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ROUTINE Nov. 2006 | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| subroutine strain_history (params,os,cl) use definitions !use mpi implicit none include 'mpif.h' !------------------------------------------------------------------------------| !(((((((((((((((( Purpose of the routine )))))))))))))))))))))))))))))))))))))) !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine arguments )))))))))))))))))))) !------------------------------------------------------------------------------| type (parameters) params type (octreesolve) os type (cloud) cl !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine internal variables ))))))))))))) !------------------------------------------------------------------------------| integer i,iproc,nproc,ierr,ni,nr double precision dxyz,height !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- call mpi_comm_size (mpi_comm_world,nproc,ierr) call mpi_comm_rank (mpi_comm_world,iproc,ierr) select case(trim(params%infile)) case('input.model1') dxyz=2.d0**(-6) do i=1,size(cl%x) ! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz ) cl%strain(i)=3.d0 if (abs(cl%y(i)-0.5d0)<dxyz/2.d0 .and. cl%z(i)<dxyz ) cl%strain(i)=3.d0 ! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)<0.5d0) cl%strain(i)=3.5d0 ! if (abs(cl%y(i)-(0.5d0-3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)>0.5d0 .and. cl%x(i)<0.75d0) cl%strain(i)=3.5d0 ! if (abs(cl%y(i)-(0.5d0+5.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)>0.75d0) cl%strain(i)=3.5d0 end do call update_cloud_structure (cl,os,params,ni,nr,0) case('input.model2') dxyz=1.2d0*2.d0**(-5) height=7.d-2 do i=1,size(cl%x) if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. & cl%z(i).ge.height .and. & cl%z(i).le.0.5d0*dxyz+height ) cl%strain(i)=4.5d0 ! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. & ! cl%z(i).ge.height .and. & ! cl%z(i).le.dxyz+height .and. & ! cl%x(i)<0.5d0 ) cl%strain(i)=3.5d0 ! if (abs(cl%y(i)-(0.5d0-3.d0*dxyz/2.d0))<dxyz/2.d0 .and. & ! cl%z(i).ge.height .and. & ! cl%z(i).le.dxyz+height .and. & ! cl%x(i)>0.5d0 .and. & ! cl%x(i)<0.75d0 ) cl%strain(i)=3.5d0 ! if (abs(cl%y(i)-(0.5d0+5.d0*dxyz/2.d0))<dxyz/2.d0 .and. & ! cl%z(i).ge.height .and. & ! cl%z(i).le.dxyz+height .and. & ! cl%x(i)>0.75d0 ) cl%strain(i)=3.5d0 end do call update_cloud_structure (cl,os,params,ni,nr,0) end select end subroutine !------------------------------------------------------------------------------- !-------------------------------------------------------------------------------