Ignore:
Timestamp:
07/16/14 18:05:01 (10 years ago)
Author:
milmd
Message:

Last LMDZ version (1315) with OpenMP directives and other stuff

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/moistadj.F90

    r222 r227  
    1 subroutine moistadj(ngrid, nq, pt, pq, pdq, pplev, pplay, pdtmana, pdqmana, ptimestep, rneb) 
     1subroutine moistadj(ngrid, nlayer, nq, pt, pq, pdq, pplev, pplay, pdtmana, pdqmana, ptimestep, rneb) 
    22 
    33  use watercommon_h, only: T_h2O_ice_liq, RLVTT, RCPD, RCPV, Psat_water, Lcpdqsat_water 
    4   USE tracer_h 
     4  USE tracer_h, only: igcm_h2o_vap, igcm_h2o_ice 
    55 
    66  implicit none 
    … …  
    2020!===================================================================== 
    2121 
    22 #include "dimensions.h" 
    23 #include "dimphys.h" 
     22!#include "dimensions.h" 
     23!#include "dimphys.h" 
    2424#include "comcstfi.h" 
    2525 
    26       INTEGER ngrid, nq 
    27  
    28       REAL pt(ngrid,nlayermx)            ! temperature (K) 
    29       REAL pq(ngrid,nlayermx,nq)       ! tracer (kg/kg) 
    30       REAL pdq(ngrid,nlayermx,nq) 
    31  
    32       REAL pdqmana(ngrid,nlayermx,nq)  ! tendency of tracers (kg/kg.s-1) 
    33       REAL pdtmana(ngrid,nlayermx)       ! temperature increment 
     26      INTEGER,INTENT(IN) :: ngrid, nlayer, nq 
     27 
     28      REAL,INTENT(IN) :: pt(ngrid,nlayer) ! temperature (K) 
     29      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq) ! tracer (kg/kg) 
     30      REAL,INTENT(IN) :: pdq(ngrid,nlayer,nq) 
     31      REAL,INTENT(IN) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa) 
     32      REAL,INTENT(IN) :: pplay(ngrid,nlayer)   ! mid-layer pressure (Pa) 
     33      REAL,INTENT(IN) :: ptimestep ! physics timestep (s) 
     34      REAL,INTENT(OUT) :: pdqmana(ngrid,nlayer,nq)  ! tracer tendencies (kg/kg.s-1) 
     35      REAL,INTENT(OUT) :: pdtmana(ngrid,nlayer) ! temperature increment(K/s) 
     36      REAL,INTENT(OUT) :: rneb(ngrid,nlayer) ! cloud fraction  
    3437 
    3538!     local variables 
    36       REAL zt(ngrid,nlayermx)      ! temperature (K) 
    37       REAL zq(ngrid,nlayermx)      ! humidite specifique (kg/kg) 
    38       REAL pplev(ngrid,nlayermx+1) ! pression a inter-couche (Pa) 
    39       REAL pplay(ngrid,nlayermx)   ! pression au milieu de couche (Pa) 
    40  
    41       REAL d_t(ngrid,nlayermx)     ! temperature increment 
    42       REAL d_q(ngrid,nlayermx)     ! incrementation pour vapeur d'eau 
    43       REAL d_ql(ngrid,nlayermx)    ! incrementation pour l'eau liquide 
    44       REAL rneb(ngrid,nlayermx) ! cloud fraction  
    45       REAL ptimestep 
     39      REAL zt(ngrid,nlayer)      ! temperature (K) 
     40      REAL zq(ngrid,nlayer)      ! humidite specifique (kg/kg) 
     41 
     42      REAL d_t(ngrid,nlayer)     ! temperature increment 
     43      REAL d_q(ngrid,nlayer)     ! incrementation pour vapeur d'eau 
     44      REAL d_ql(ngrid,nlayer)    ! incrementation pour l'eau liquide 
    4645 
    4746!      REAL t_coup 
    … …  
    5554      INTEGER k1, k1p, k2, k2p 
    5655      LOGICAL itest(ngrid) 
    57       REAL delta_q(ngrid, nlayermx) 
    58       DOUBLE PRECISION :: cp_new_t(nlayermx), v_cptt(ngrid,nlayermx) 
    59       REAL cp_delta_t(nlayermx) 
    60       DOUBLE PRECISION :: v_cptj(nlayermx), v_cptjk1, v_ssig 
     56      REAL delta_q(ngrid, nlayer) 
     57      DOUBLE PRECISION :: cp_new_t(nlayer), v_cptt(ngrid,nlayer) 
     58      REAL cp_delta_t(nlayer) 
     59      DOUBLE PRECISION :: v_cptj(nlayer), v_cptjk1, v_ssig 
    6160      REAL v_p, v_t, v_zqs,v_cptt2,v_pratio,v_dlnpsat 
    62       REAL zqs(ngrid,nlayermx), zdqs(ngrid,nlayermx),zpsat(ngrid,nlayermx),zdlnpsat(ngrid,nlayermx) 
     61      REAL zqs(ngrid,nlayer), zdqs(ngrid,nlayer),zpsat(ngrid,nlayer),zdlnpsat(ngrid,nlayer) 
    6362      REAL zq1(ngrid), zq2(ngrid) 
    64       DOUBLE PRECISION :: gamcpdz(ngrid,2:nlayermx) 
     63      DOUBLE PRECISION :: gamcpdz(ngrid,2:nlayer) 
    6564      DOUBLE PRECISION :: zdp, zdpm 
    6665 
    … …  
    6867      REAL zflo ! flotabilite 
    6968 
    70       DOUBLE PRECISION :: local_q(ngrid,nlayermx),local_t(ngrid,nlayermx) 
     69      DOUBLE PRECISION :: local_q(ngrid,nlayer),local_t(ngrid,nlayer) 
    7170 
    7271      REAL zdelta, zcor, zcvm5 
    … …  
    7877      INTEGER,SAVE :: i_h2o=0  ! water vapour 
    7978      INTEGER,SAVE :: i_ice=0  ! water ice 
    80  
    81       LOGICAL firstcall 
    82       SAVE firstcall 
    83  
    84       DATA firstcall /.TRUE./ 
     79!$OMP THREADPRIVATE(i_h2o,i_ice) 
     80 
     81      LOGICAL,SAVE :: firstcall=.TRUE. 
     82!$OMP THREADPRIVATE(firstcall) 
    8583 
    8684      IF (firstcall) THEN 
    … …  
    9694 
    9795!     GCM -----> subroutine variables 
    98       zq(1:ngrid,1:nlayermx)    = pq(1:ngrid,1:nlayermx,i_h2o)+ pdq(1:ngrid,1:nlayermx,i_h2o)*ptimestep 
    99       zt(1:ngrid,1:nlayermx)    = pt(1:ngrid,1:nlayermx) 
    100       pdqmana(1:ngrid,1:nlayermx,1:nq)=0.0 
    101  
    102       DO k = 1, nlayermx 
     96      zq(1:ngrid,1:nlayer)    = pq(1:ngrid,1:nlayer,i_h2o)+ pdq(1:ngrid,1:nlayer,i_h2o)*ptimestep 
     97      zt(1:ngrid,1:nlayer)    = pt(1:ngrid,1:nlayer) 
     98      pdqmana(1:ngrid,1:nlayer,1:nq)=0.0 
     99 
     100      DO k = 1, nlayer 
    103101       DO i = 1, ngrid 
    104102         if(zq(i,k).lt.0.)then 
    … …  
    108106      ENDDO 
    109107       
    110       local_q(1:ngrid,1:nlayermx) = zq(1:ngrid,1:nlayermx) 
    111       local_t(1:ngrid,1:nlayermx) = zt(1:ngrid,1:nlayermx) 
    112       rneb(1:ngrid,1:nlayermx) = 0.0 
    113       d_ql(1:ngrid,1:nlayermx) = 0.0 
    114       d_t(1:ngrid,1:nlayermx)  = 0.0 
    115       d_q(1:ngrid,1:nlayermx)  = 0.0 
     108      local_q(1:ngrid,1:nlayer) = zq(1:ngrid,1:nlayer) 
     109      local_t(1:ngrid,1:nlayer) = zt(1:ngrid,1:nlayer) 
     110      rneb(1:ngrid,1:nlayer) = 0.0 
     111      d_ql(1:ngrid,1:nlayer) = 0.0 
     112      d_t(1:ngrid,1:nlayer)  = 0.0 
     113      d_q(1:ngrid,1:nlayer)  = 0.0 
    116114 
    117115!     Calculate v_cptt 
    118       DO k = 1, nlayermx 
     116      DO k = 1, nlayer 
    119117         DO i = 1, ngrid 
    120118            v_cptt(i,k) = RCPD * local_t(i,k) 
    … …  
    128126 
    129127!     Calculate Gamma * Cp * dz: (gamma is the critical gradient) 
    130       DO k = 2, nlayermx 
     128      DO k = 2, nlayer 
    131129         DO i = 1, ngrid 
    132130            zdp = pplev(i,k)-pplev(i,k+1) 
    … …  
    159157  810 CONTINUE ! look for k1, the base of the column 
    160158      k2 = k2 + 1 
    161       IF (k2 .GT. nlayermx) GOTO 9999 
     159      IF (k2 .GT. nlayer) GOTO 9999 
    162160      zflo = v_cptt(i,k2-1) - v_cptt(i,k2) - gamcpdz(i,k2) 
    163161      zsat=(local_q(i,k2-1)-zqs(i,k2-1))*(pplev(i,k2-1)-pplev(i,k2))   & 
    … …  
    169167 
    170168  820 CONTINUE !! look for k2, the top of the column 
    171       IF (k2 .EQ. nlayermx) GOTO 821 
     169      IF (k2 .EQ. nlayer) GOTO 821 
    172170      k2p = k2 + 1 
    173171      zsat=zsat+(pplev(i,k2p)-pplev(i,k2p+1))*(local_q(i,k2p)-zqs(i,k2p)) 
    … …  
    227225!      ENDDO 
    228226 
    229       DO k = 2, nlayermx 
     227      DO k = 2, nlayer 
    230228         zdpm = pplev(i,k-1) - pplev(i,k) 
    231229         zdp = pplev(i,k) - pplev(i,k+1) 
    … …  
    272270! a l'endroit ou la vapeur d'eau est diminuee par l'ajustement): 
    273271 
    274       DO k = 1, nlayermx 
     272      DO k = 1, nlayer 
    275273      DO i = 1, ngrid 
    276274         IF (itest(i)) THEN 
    … …  
    291289         ENDIF 
    292290      ENDDO 
    293       DO k = 1, nlayermx 
     291      DO k = 1, nlayer 
    294292      DO i = 1, ngrid 
    295293         IF (itest(i)) THEN 
    … …  
    300298      ENDDO 
    301299      ENDDO 
    302       DO k = 1, nlayermx 
     300      DO k = 1, nlayer 
    303301      DO i = 1, ngrid 
    304302         IF (itest(i)) THEN 
    … …  
    308306      ENDDO 
    309307 
    310       DO k = 1, nlayermx 
     308      DO k = 1, nlayer 
    311309      DO i = 1, ngrid 
    312310          local_q(i, k) = MAX(local_q(i, k), seuil_vap) 
    … …  
    314312      ENDDO 
    315313 
    316       DO k = 1, nlayermx 
     314      DO k = 1, nlayer 
    317315      DO i = 1, ngrid 
    318316         d_t(i,k) = local_t(i,k) - zt(i,k) 
    … …  
    322320 
    323321!     now subroutine -----> GCM variables 
    324       DO k = 1, nlayermx 
     322      DO k = 1, nlayer 
    325323         DO i = 1, ngrid 
    326324             
    … …  
    333331 
    334332 
    335       RETURN 
    336333   END 
Note: See TracChangeset for help on using the changeset viewer.