MODULE physics_dry_mod USE ICOSA PUBLIC init_physics_dry, physics_dry CONTAINS SUBROUTINE init_physics_dry USE ICOSA !sarvesh USE time_mod !sarvesh USE dimphys_mod USE RADIATION IMPLICIT NONE INTEGER::i,j,ij !-------------------------------------- ORBITAL PARAMETER---- periheli=150. CALL getin('periheli', periheli) aphelie=150. CALL getin('aphelie',aphelie) coefir=0.08 CALL getin('coefir',coefir) coefvis=0.99 CALL getin('coefvis',coefvis) obliquit=0.0 CALL getin('obliquit',obliquit) peri_day=0. CALL getin('peri_day',peri_day) year_day=360. CALL getin('year_day',year_day) callrad=.true. CALL getin('callrad', callrad) calldifv=.true. CALL getin('calldifv', calldifv) calladj=.true. CALL getin('calladj', calladj) callcond=.true. callsoil=.true. CALL getin('callsoil',callsoil) season=.true. CALL getin('season',season) diurnal=.true. CALL getin('diurnal',diurnal) lverbose=.false. CALL getin('lverbose',lverbose) period_sort=1. CALL getin('period_sort',period_sort) ! ptimestep=dt ! CALL getin('ptimestep',ptimestep) print*,'Activation de la physique:' print*,' Rayonnement ',callrad print*,' Diffusion verticale turbulente ', calldifv print*,' Ajustement convectif ',calladj print*,' Sol ',callsoil print*,' Cycle diurne ',diurnal ! choice of the frequency of the computation of radiations IF(diurnal) THEN iradia=NINT(daysec/(20.*dt)) ELSE iradia=NINT(daysec/(4.*dt)) ENDIF iradia=1 ngridmx=iim*jjm ; nlayermx=llm offset=halo ALLOCATE(albedo(ngridmx));ALLOCATE(emissiv(ngridmx)) ALLOCATE(inertie(ngridmx));ALLOCATE(z0(ngridmx)) ALLOCATE(rnatur(ngridmx));ALLOCATE(tsurf(ngridmx)) ALLOCATE(tsoil(ngridmx,nlayermx));ALLOCATE(fluxgrd(ngridmx)) ALLOCATE(fluxrad(ngridmx));ALLOCATE(dtrad(ngridmx,llm+1)) ALLOCATE(q2(ngridmx,llm+1));ALLOCATE(q2l(ngridmx,llm+1)) ALLOCATE(capcal(ngridmx)) CALL iniorbit(aphelie,periheli,year_day,peri_day,obliquit) PRINT*,'unjours',daysec PRINT*,'The radiative transfer is computed each ', iradia,' physical time-step or each ', & iradia*dt,' seconds' END SUBROUTINE init_physics_dry SUBROUTINE physics_dry( it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) USE icosa IMPLICIT NONE INTEGER,INTENT(IN) :: it REAL(rstd),INTENT(IN) :: jD_cur,jH_cur TYPE(t_field),POINTER :: f_phis(:) TYPE(t_field),POINTER :: f_ps(:) TYPE(t_field),POINTER :: f_theta_rhodz(:) TYPE(t_field),POINTER :: f_ue(:) TYPE(t_field),POINTER :: f_q(:) REAL(rstd),POINTER :: phis(:) REAL(rstd),POINTER :: ps(:) REAL(rstd),POINTER :: theta_rhodz(:,:) REAL(rstd),POINTER :: ue(:,:) REAL(rstd),POINTER :: q(:,:,:) ! REAL(rstd),POINTER :: precl(:) INTEGER :: ind ! LOGICAL:: firstcall,lastcall CALL transfert_request(f_ue,req_e1_vect) CALL transfert_request(f_theta_rhodz,req_i1) DO ind=1,ndomain CALL swap_dimensions(ind) CALL swap_geometry(ind) phis=f_phis(ind) ps=f_ps(ind) theta_rhodz=f_theta_rhodz(ind) ue=f_ue(ind) q=f_q(ind) ! out_i=f_out_i(ind) ! precl=f_precl(ind) ! print*,"====================================ind",ind,"----------it",it CALL compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q(:,:,1)) ENDDO ! CALL writefield("out_i",f_out_i) ! IF (mod(it,itau_out)==0 ) THEN ! CALL writefield("precl",f_precl) ! ENDIF END SUBROUTINE physics_dry SUBROUTINE compute_physics_dry(it,jD_cur,jH_cur,phis, ps, theta_rhodz, ue, q) USE icosa USE pression_mod USE exner_mod USE theta2theta_rhodz_mod USE geopotential_mod USE wind_mod USE PHY IMPLICIT NONE INTEGER::it REAL(rstd) :: jD_cur REAL(rstd) :: jH_cur REAL(rstd) :: phis(iim*jjm) REAL(rstd) :: ps(iim*jjm) REAL(rstd) :: theta_rhodz(iim*jjm,llm) REAL(rstd) :: ue(3*iim*jjm,llm) REAL(rstd) :: q(iim*jjm,llm) ! REAL(rstd) :: precl(iim*jjm) REAL(rstd) :: p(iim*jjm,llm+1) REAL(rstd) :: pks(iim*jjm) REAL(rstd) :: pk(iim*jjm,llm) REAL(rstd) :: phi(iim*jjm,llm) REAL(rstd) :: T(iim*jjm,llm) REAL(rstd) :: Tfi(iim*jjm,llm) REAL(rstd) :: theta(iim*jjm,llm) REAL(rstd) :: uc(iim*jjm,3,llm) REAL(rstd) :: u(iim*jjm,llm) REAL(rstd) :: v(iim*jjm,llm) REAL(rstd) :: ufi(iim*jjm,llm) REAL(rstd) :: vfi(iim*jjm,llm) REAL(rstd) :: qfi(iim*jjm,llm) REAL(rstd) :: utemp(iim*jjm,llm) REAL(rstd) :: vtemp(iim*jjm,llm) REAL(rstd) :: lat(iim*jjm) REAL(rstd) :: lon(iim*jjm) REAL(rstd) :: pmid(iim*jjm,llm) REAL(rstd) :: pint(iim*jjm,llm+1) REAL(rstd) :: pdel(iim*jjm,llm) REAL(rstd) :: plev(iim*jjm,llm+1),play(iim*jjm,llm) REAL(rstd) :: pkbycp INTEGER :: i,j,l,ij,ig !------------------- ! LOGICAL:: firstcall,lastcall REAL(rstd) :: dufi(iim*jjm,llm) REAL(rstd) :: dvfi(iim*jjm,llm) REAL(rstd) :: dTfi(iim*jjm,llm) REAL(rstd) :: dpsfi(iim*jjm) REAL(rstd) :: dqfi(iim*jjm,llm) ! PRINT *,'Entering in LMD SIMPLE physics' offset=halo CALL compute_pression(ps,p,halo) CALL compute_exner(ps,p,pks,pk,halo) CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,halo) CALL compute_geopotential(phis,pks,pk,theta,phi,halo) CALL compute_theta_rhodz2temperature(ps,theta_rhodz,T,halo) CALL compute_wind_centered(ue,uc) CALL compute_wind_centered_lonlat_compound(uc, u, v) DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i CALL xyz2lonlat(xyz_i(ij,:),lon(ij),lat(ij)) ENDDO ENDDO DO l=1,llm DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i ! Tfi(ij,l)=T(ij,l) ! ufi(ij,l)=u(ij,l) ! vfi(ij,l)=v(ij,l) ! qfi(ij,l)=q(ij,l) dTfi(ij,l)=0.0 dufi(ij,l)=0.0 dvfi(ij,l)=0.0 dqfi(ij,l)=0.0 ENDDO ENDDO ENDDO plev(:,:) = p(:,:) dpsfi=0.0 DO l=1,llm DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i pkbycp=pk(ij,l)/cpp play(ij,l)=preff*pkbycp**(1./kappa) ENDDO ENDDO ENDDO CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & plev,play,phi,phis,u,v,T,q,dufi,dvfi,dTfi,dqfi,dpsfi) CALL ADDFI(u,v,T,q,ps,dufi,dvfi,dTfi,dqfi,dpsfi) ! CALL SARCHECKF(llm) ! print*,"plev",(maxval(plev(:,l)),l=1,llm+1) ! CALL phyparam_lmd(it,iim*jjm,llm,1,dt,lat,lon,jD_cur,jH_cur, & ! plev,play,phi,phis,ufi,vfi,Tfi,qfi,dufi,dvfi,dTfi,dqfi,dpsfi) ! Print*,"going ADD FI",it ! CALL ADDFI(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) ! WRITE(11,*)"ducovfi",maxval(dufi),minval(dufi),it ! WRITE(11,*)"ucovfi",maxval(ufi),minval(ufi) ! WRITE(11,*)"dtetafi",maxval(dTfi),minval(dTfi) !============================================= ! go to 1234 DO l=1,llm DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i uc(ij,:,l)=(dufi(ij,l)*elon_i(ij,:)+dvfi(ij,l)*elat_i(ij,:))*dt ENDDO ENDDO ENDDO DO l=1,llm DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i ue(ij+u_right,l)=ue(ij+u_right,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_right,:,l))*ep_e(ij+u_right,:) ) ue(ij+u_lup,l)=ue(ij+u_lup,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_lup,:,l))*ep_e(ij+u_lup,:) ) ue(ij+u_ldown,l)=ue(ij+u_ldown,l)+sum( 0.5*(uc(ij,:,l) + uc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) ) ENDDO ENDDO ENDDO !1234 continue ! CALL compute_temperature2theta_rhodz(ps,Tfi,theta_rhodz,halo) CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,halo) ! WRITE(13,*)"tetafi",maxval(theta_rhodz),minval(theta_rhodz) RETURN END SUBROUTINE compute_physics_dry SUBROUTINE addfi(ufi,vfi,Tfi,qfi,ps,dufi,dvfi,dTfi,dqfi,dpsfi) USE ICOSA IMPLICIT NONE REAL(rstd) :: dufi(iim*jjm,llm) REAL(rstd) :: dvfi(iim*jjm,llm) REAL(rstd) :: dTfi(iim*jjm,llm) REAL(rstd) :: dpsfi(iim*jjm) REAL(rstd) :: dqfi(iim*jjm,llm) REAL(rstd) :: ufi(iim*jjm,llm) REAL(rstd) :: vfi(iim*jjm,llm) REAL(rstd) :: qfi(iim*jjm,llm) REAL(rstd) :: ps(iim*jjm) REAL(rstd) :: Tfi(iim*jjm,llm) INTEGER::i,j,l,ij,offset offset=halo DO l=1,llm DO j=jj_begin-offset,jj_end+offset DO i=ii_begin-offset,ii_end+offset ij=(j-1)*iim+i Tfi(ij,l)=Tfi(ij,l)+dTfi(ij,l)*dt ufi(ij,l)=ufi(ij,l)+dufi(ij,l)*dt vfi(ij,l)=vfi(ij,l)+dvfi(ij,l)*dt qfi(ij,l)=qfi(ij,l)+dqfi(ij,l)*dt END DO END DO END DO ps(:)=ps(:) + dpsfi(:)*dt END SUBROUTINE addfi END MODULE physics_dry_mod