106 #include "dimensions.h"
113 #include "comconst.h"
115 #include "comgeom2.h"
116 #include "iniprint.h"
122 LOGICAL,
INTENT(IN) :: lafin
123 REAL,
INTENT(IN):: jD_cur, jH_cur
154 INTEGER i,j,l,ig0,ig,iq,iiq
155 REAL,
ALLOCATABLE,
SAVE :: zpsrf(:)
156 REAL,
ALLOCATABLE,
SAVE :: zplev(:,:),zplay(:,:)
157 REAL,
ALLOCATABLE,
SAVE :: zphi(:,:),zphis(:)
160 REAL,
ALLOCATABLE,
SAVE :: zufi(:,:), zvfi(:,:), zrfi(:,:)
161 REAL,
ALLOCATABLE,
SAVE :: ztfi(:,:),zqfi(:,:,:)
163 REAL,
ALLOCATABLE,
SAVE :: pcvgu(:,:), pcvgv(:,:)
164 REAL,
ALLOCATABLE,
SAVE :: pcvgt(:,:), pcvgq(:,:,:)
166 REAL,
ALLOCATABLE,
SAVE :: zdufi(:,:),zdvfi(:,:)
167 REAL,
ALLOCATABLE,
SAVE :: zdtfi(:,:),zdqfi(:,:,:)
168 REAL,
ALLOCATABLE,
SAVE :: zdpsrf(:)
169 REAL,
SAVE,
ALLOCATABLE :: flxwfi(:,:)
172 REAL,
ALLOCATABLE,
SAVE :: zplev_omp(:,:)
173 REAL,
ALLOCATABLE,
SAVE :: zplay_omp(:,:)
174 REAL,
ALLOCATABLE,
SAVE :: zphi_omp(:,:)
175 REAL,
ALLOCATABLE,
SAVE :: zphis_omp(:)
176 REAL,
ALLOCATABLE,
SAVE :: presnivs_omp(:)
177 REAL,
ALLOCATABLE,
SAVE :: zufi_omp(:,:)
178 REAL,
ALLOCATABLE,
SAVE :: zvfi_omp(:,:)
179 REAL,
ALLOCATABLE,
SAVE :: zrfi_omp(:,:)
180 REAL,
ALLOCATABLE,
SAVE :: ztfi_omp(:,:)
181 REAL,
ALLOCATABLE,
SAVE :: zqfi_omp(:,:,:)
182 REAL,
ALLOCATABLE,
SAVE :: zdufi_omp(:,:)
183 REAL,
ALLOCATABLE,
SAVE :: zdvfi_omp(:,:)
184 REAL,
ALLOCATABLE,
SAVE :: zdtfi_omp(:,:)
185 REAL,
ALLOCATABLE,
SAVE :: zdqfi_omp(:,:,:)
186 REAL,
ALLOCATABLE,
SAVE :: zdpsrf_omp(:)
187 REAL,
SAVE,
ALLOCATABLE :: flxwfi_omp(:,:)
202 REAL,
ALLOCATABLE,
SAVE :: zdufic_omp(:,:)
203 REAL,
ALLOCATABLE,
SAVE :: zdvfic_omp(:,:)
204 REAL,
ALLOCATABLE,
SAVE :: zdtfic_omp(:,:)
205 REAL,
ALLOCATABLE,
SAVE :: zdqfic_omp(:,:,:)
206 REAL jH_cur_split,zdt_split
207 LOGICAL debut_split,lafin_split
217 LOGICAL,
SAVE :: first_omp=.
true.
221 REAL zsinbis(
iim),zcosbis(
iim),z1bis(
iim)
226 LOGICAL,
SAVE :: firstcal=.
true., debut=.
true.
229 REAL,
SAVE,
dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
232 INTEGER,
dimension(MPI_STATUS_SIZE,4) :: Status
234 INTEGER,
dimension(1,4) :: Status
236 INTEGER,
dimension(4) :: Req
237 REAL,
ALLOCATABLE,
SAVE:: zdufi2(:,:),zdvfi2(:,:)
238 integer :: k,kstart,kend
255 IF (ngridmx.NE.2+(jjm-1)*
iim)
THEN
256 write(
lunout,*)
'STOP dans calfis'
258 &
'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
259 write(
lunout,*)
' ngridmx jjm iim '
264 ALLOCATE(zpsrf(
klon))
273 ALLOCATE(zdpsrf(
klon))
325 zplev( ig0,l ) = pp(i,j,l)
341 pksurcp = ppk(i,j,l) /
cpp
342 zplay(ig0,l) =
preff * pksurcp ** unskap
343 ztfi(ig0,l) = pteta(i,j,l) * pksurcp
362 zqfi(ig0,l,iq) = pq(i,j,l,iiq)
379 zphi(ig0,l) = pphi(i,j,l)
392 zphis(ig0) = pphis(i,j)
404 zphi(ig,l)=zphi(ig,l)-zphis(ig)
429 zufi(ig0,l)= 0.5 *( pucov(
iim,j,l)/
cu(
iim,j)
430 $ + pucov(1,j,l)/
cu(1,j) )
432 zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/
cu(i-1,j)
433 $ + pucov(i,j,l)/
cu(i,j) )
454 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l)
455 $ + pucov(i,j+1,l) - pucov(i,j,l))
456 $ / (
cu(i,j)+
cu(i,j+1))
457 $ / (
cv(i+1,j)+
cv(i,j)) *4
473 zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/
cv(i,j-1)
474 $ + pvcov(i,j,l)/
cv(i,j) )
475 if (j==1 .OR. j==
jjp1)
then
479 zrfi(ig0,l)= 0.25 *(zrot(
iim,j-1,l)+zrot(
iim,j,l)
480 $ +zrot(1,j-1,l)+zrot(1,j,l))
482 zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l)
483 $ +zrot(i,j-1,l)+zrot(i,j,l))
507 zcos(i) = cos(
rlonv(i))*z1(i)
508 zsin(i) = sin(
rlonv(i))*z1(i)
511 zufi(1,l) = ssum(
iim,zcos,1)/
pi
512 zvfi(1,l) = ssum(
iim,zsin,1)/
pi
535 zcos(i) = cos(
rlonv(i))*z1(i)
536 zsin(i) = sin(
rlonv(i))*z1(i)
554 flxwfi(ig0,l) = flxw(i,j,l)
570 allocate(zplev_omp(
klon,
llm+1))
573 allocate(zphis_omp(
klon))
574 allocate(presnivs_omp(
llm))
588 allocate(zdpsrf_omp(
klon))
599 zplev_omp(i,l)=zplev(offset+i,l)
605 zplay_omp(i,l)=zplay(offset+i,l)
611 zphi_omp(i,l)=zphi(offset+i,l)
616 zphis_omp(i)=zphis(offset+i)
626 zufi_omp(i,l)=zufi(offset+i,l)
632 zvfi_omp(i,l)=zvfi(offset+i,l)
638 zrfi_omp(i,l)=zrfi(offset+i,l)
644 ztfi_omp(i,l)=ztfi(offset+i,l)
651 zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
658 zdufi_omp(i,l)=zdufi(offset+i,l)
664 zdvfi_omp(i,l)=zdvfi(offset+i,l)
670 zdtfi_omp(i,l)=zdtfi(offset+i,l)
677 zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
683 zdpsrf_omp(i)=zdpsrf(offset+i)
688 flxwfi_omp(i,l)=flxwfi(offset+i,l)
708 debut_split=debut.and.isplit==1
767 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
768 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
769 ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
770 zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
772 zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
773 zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
774 zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
775 zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
792 zplev(offset+i,l)=zplev_omp(i,l)
798 zplay(offset+i,l)=zplay_omp(i,l)
804 zphi(offset+i,l)=zphi_omp(i,l)
810 zphis(offset+i)=zphis_omp(i)
820 zufi(offset+i,l)=zufi_omp(i,l)
826 zvfi(offset+i,l)=zvfi_omp(i,l)
832 ztfi(offset+i,l)=ztfi_omp(i,l)
839 zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
846 zdufi(offset+i,l)=zdufi_omp(i,l)
852 zdvfi(offset+i,l)=zdvfi_omp(i,l)
858 zdtfi(offset+i,l)=zdtfi_omp(i,l)
865 zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
871 zdpsrf(offset+i)=zdpsrf_omp(i)
889 du_send(1:
iim,l)=zdufi(1:
iim,l)
890 dv_send(1:
iim,l)=zdvfi(1:
iim,l)
930 call mpi_waitall(4,req(1),status,ierr)
932 call mpi_waitall(2,req(1),status,ierr)
934 call mpi_waitall(2,req(3),status,ierr)
997 pdpsfi(i,j) = zdpsrf(ig0)
998 if (i==1) pdpsfi(iip1,j) = zdpsrf(ig0)
1003 pdpsfi(i,1) = zdpsrf(1)
1034 pdhfi(i,j,l) =
cpp * zdtfi(ig0,l) / ppk(i,j,l)
1035 if (i==1) pdhfi(iip1,j,l) =
cpp * zdtfi(ig0,l) / ppk(i,j,l)
1040 pdhfi(i,1,l) =
cpp * zdtfi(1,l) / ppk(i, 1 ,l)
1103 pdqfi(i,j,l,iiq) = zdqfi(ig0,l,iq)
1104 if (i==1) pdqfi(iip1,j,l,iiq) = zdqfi(ig0,l,iq)
1109 pdqfi(i,1,l,iiq) = zdqfi(1,l,iq)
1115 pdqfi(i,
jjp1,l,iiq) = zdqfi(
klon,l,iq)
1135 pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*
cu(i,j)
1139 pdufi(
iim,j,l)=0.5*( zdufi2(ig0,l)
1141 pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*
cu(i,j)
1154 pdufi(i,
jjp1,l) = 0.
1178 pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+
iim,l))*
cv(i,j)
1179 if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+
1180 $ zdvfi2(ig0+
iim,l))
1199 $ zdufi(1,l)*cos(
rlonv(i))+zdvfi(1,l)*sin(
rlonv(i))
1202 $ 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*
cv(i,1)
1205 pdvfi(iip1,1,l) = pdvfi(1,1,l)
1218 pdvfi(i,jjm,l)=zdufi(
klon,l)*cos(
rlonv(i))
1222 $ 0.5*(pdvfi(i,jjm,l)+zdvfi(
klon-iip1+i,l))*
cv(i,jjm)
1225 pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
1239 &
"calfis_p: for now can only work with parallel physics"
integer, dimension(:), allocatable, save index_i
logical, save is_south_pole
integer, parameter timer_physic
subroutine stop_timer(no_timer)
!$Id mode_top_bound COMMON comconstr kappa
subroutine calfis_loc(lafin, jD_cur, jH_cur, pucov, pvcov, pteta, pq, pmasse, pps, pp, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, flxw, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
character(len=10), save planet_type
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
integer, dimension(:), allocatable, save index_j
!$Id mode_top_bound COMMON comconstr && pi
!$Id mode_top_bound COMMON comconstr dtphys
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
subroutine physiq(nlon, nlev, debut, lafin, jD_cur, jH_cur, pdtphys, paprs, pplay, pphi, pphis, presnivs, u, v, rot, t, qx, flxmass_w, d_u, d_v, d_t, d_qx, d_ps, dudyn)
!$Id mode_top_bound COMMON comconstr cpp
integer, save klon_omp_begin
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
!$Id mode_top_bound COMMON comconstr daysec
!$Header!CDK comgeom COMMON comgeom rlonu
character(len=20), dimension(:), allocatable, save tname
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
!$Id!Parameters for parameters that control the rate of approach!to quasi equilibrium noff nlm real tlcrit real entp real sigd real coeffs real dtmax real cu real betad real damp real delta COMMON cvparam nlm tlcrit sigd coeffs cu
integer, dimension(:), allocatable, save niadv
!$Id mode_top_bound COMMON comconstr dtvr
integer, save nsplit_phys
logical, save is_north_pole
c c zjulian c cym CALL iim cym klev iim
subroutine start_timer(no_timer)
!$Header!CDK comgeom COMMON comgeom cv
INTERFACE SUBROUTINE RRTM_ECRT_140GP && pq
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
!$Header!CDK comgeom COMMON comgeom rlonv