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