Changeset 1067 for LMDZ4/trunk/libf


Ignore:
Timestamp:
Dec 17, 2008, 2:30:13 PM (16 years ago)
Author:
Laurent Fairhead
Message:
  • Modifications lie au premier niveau du modele pour la diffusion turbulent

du vent.

  • Preparation pour un couplage des courrant oceaniques.

JG

Location:
LMDZ4/trunk/libf/phylmd
Files:
24 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/calcul_fluxs_mod.F90

    r793 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE calcul_fluxs_mod
    … …  
    243241!
    244242  END SUBROUTINE calcul_fluxs
    245 
     243!
     244!****************************************************************************************
     245!
     246  SUBROUTINE calcul_flux_wind(knon, dtime, &
     247       u0, v0, u1, v1, cdrag_m, &
     248       AcoefU, AcoefV, BcoefU, BcoefV, &
     249       p1lay, t1lay, &
     250       flux_u1, flux_v1)
     251
     252    USE dimphy
     253    INCLUDE "YOMCST.h"
     254
     255! Input arguments
     256!****************************************************************************************
     257    INTEGER, INTENT(IN)                  :: knon
     258    REAL, INTENT(IN)                     :: dtime
     259    REAL, DIMENSION(klon), INTENT(IN)    :: u0, v0  ! u and v at niveau 0
     260    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1  ! u and v at niveau 1
     261    REAL, DIMENSION(klon), INTENT(IN)    :: cdrag_m ! cdrag pour momentum
     262    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
     263    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay   ! pression 1er niveau (milieu de couche)
     264    REAL, DIMENSION(klon), INTENT(IN)    :: t1lay   ! temperature
     265! Output arguments
     266!****************************************************************************************
     267    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_u1
     268    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_v1
     269
     270! Local variables
     271!****************************************************************************************
     272    INTEGER                              :: i
     273    REAL                                 :: mod_wind, buf
     274
     275!****************************************************************************************
     276! Calculate the surface flux
     277!
     278!****************************************************************************************
     279    DO i=1,knon
     280       mod_wind = 1.0 + SQRT((u1(i) - u0(i))**2 + (v1(i)-v0(i))**2)
     281       buf = cdrag_m(i) * mod_wind * p1lay(i)/(RD*t1lay(i))
     282       flux_u1(i) = (AcoefU(i) - u0(i)) / (1/buf - BcoefU(i)*dtime )
     283       flux_v1(i) = (AcoefV(i) - v0(i)) / (1/buf - BcoefV(i)*dtime )
     284    END DO
     285
     286  END SUBROUTINE calcul_flux_wind
     287!
     288!****************************************************************************************
     289!
    246290END MODULE calcul_fluxs_mod

  • LMDZ4/trunk/libf/phylmd/clcdrag.F90

    r793 r1067  
    11!
    2 ! $Header$
    3 !
    4       SUBROUTINE clcdrag(klon, knon, nsrf, zxli, &
    5                          u, v, t, q, zgeop, &
    6                          ts, qsurf, rugos, &
    7                          pcfm, pcfh)
    8       IMPLICIT NONE
     2SUBROUTINE clcdrag(knon, nsrf, paprs, pplay,&
     3     u1, v1, t1, q1, &
     4     tsurf, qsurf, rugos, &
     5     pcfm, pcfh)
     6
     7  USE dimphy
     8  IMPLICIT NONE
    99! ================================================================= c
    1010!
    … …  
    1414! ================================================================= c
    1515!
    16 ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    1716! knon----input-I- nombre de points pour un type de surface
    1817! nsrf----input-I- indice pour le type de surface; voir indicesol.h
    19 ! zxli----input-L- calcul des cdrags selon Laurent Li
    20 ! u-------input-R- vent zonal au 1er niveau du modele
    21 ! v-------input-R- vent meridien au 1er niveau du modele
    22 ! t-------input-R- temperature de l'air au 1er niveau du modele
    23 ! q-------input-R- humidite de l'air au 1er niveau du modele
    24 ! zgeop---input-R- geopotentiel au 1er niveau du modele
    25 ! ts------input-R- temperature de l'air a la surface
     18! u1-------input-R- vent zonal au 1er niveau du modele
     19! v1-------input-R- vent meridien au 1er niveau du modele
     20! t1-------input-R- temperature de l'air au 1er niveau du modele
     21! q1-------input-R- humidite de l'air au 1er niveau du modele
     22! tsurf------input-R- temperature de l'air a la surface
    2623! qsurf---input-R- humidite de l'air a la surface
    2724! rugos---input-R- rugosite
    … …  
    4441! Quelques constantes et options:
    4542!!$PB      REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
    46       REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
     43  REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
    4744!
    4845! Variables locales :
    49       INTEGER :: i
    50       REAL :: zdu2, ztsolv, ztvd, zscf
    51       REAL :: zucf, zcr
    52       REAL :: friv, frih
    53       REAL, dimension(klon) :: zcfm1, zcfm2
    54       REAL, dimension(klon) :: zcfh1, zcfh2
    55       REAL, dimension(klon) :: zcdn
    56       REAL, dimension(klon) :: zri
     46  INTEGER               :: i
     47  REAL                  :: zdu2, ztsolv
     48  REAL                  :: ztvd, zscf
     49  REAL                  :: zucf, zcr
     50  REAL                  :: friv, frih
     51  REAL, DIMENSION(klon) :: zcfm1, zcfm2
     52  REAL, DIMENSION(klon) :: zcfh1, zcfh2
     53  REAL, DIMENSION(klon) :: zcdn
     54  REAL, DIMENSION(klon) :: zri
     55  REAL, DIMENSION(klon) :: zgeop1       ! geopotentiel au 1er niveau du modele
     56  LOGICAL, PARAMETER    :: zxli=.FALSE. ! calcul des cdrags selon Laurent Li
    5757!
    5858! Fonctions thermodynamiques et fonctions d'instabilite
    59       REAL :: fsta, fins, x
    60       fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
    61       fins(x) = SQRT(1.0-18.0*x)
     59  REAL                  :: fsta, fins, x
     60  fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
     61  fins(x) = SQRT(1.0-18.0*x)
     62
     63! ================================================================= c
     64!
     65! Calculer le geopotentiel du premier couche de modele
     66!
     67  DO i = 1, knon
     68     zgeop1(i) = RD * t1(i) / (0.5*(paprs(i,1)+pplay(i,1))) &
     69          * (paprs(i,1)-pplay(i,1))
     70  END DO
    6271! ================================================================= c
    6372!
    6473! Calculer le frottement au sol (Cdrag)
    6574!
    66       DO i = 1, knon
    67         zdu2 = max(cepdu2,u(i)**2+v(i)**2)
    68         ztsolv = ts(i) * (1.0+RETV*qsurf(i))
    69         ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
    70              *(1.+RETV*q(i))
    71         zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
    72         zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
    73 !
     75  DO i = 1, knon
     76     zdu2 = MAX(cepdu2,u1(i)**2+v1(i)**2)
     77     ztsolv = tsurf(i) * (1.0+RETV*qsurf(i))
     78     ztvd = (t1(i)+zgeop1(i)/RCPD/(1.+RVTMP2*q1(i))) &
     79          *(1.+RETV*q1(i))
     80     zri(i) = zgeop1(i)*(ztvd-ztsolv)/(zdu2*ztvd)
     81     zcdn(i) = (ckap/LOG(1.+zgeop1(i)/(RG*rugos(i))))**2
     82
    7483!!$        IF (zri(i) .ge. 0.) THEN      ! situation stable
    75         IF (zri(i) .gt. 0.) THEN      ! situation stable
    76           zri(i) = min(20.,zri(i))
    77           IF (.NOT.zxli) THEN
    78             zscf = SQRT(1.+cd*ABS(zri(i)))
    79             FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
    80             zcfm1(i) = zcdn(i) * FRIV
    81             FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
     84     IF (zri(i) .GT. 0.) THEN      ! situation stable
     85        zri(i) = MIN(20.,zri(i))
     86        IF (.NOT.zxli) THEN
     87           zscf = SQRT(1.+cd*ABS(zri(i)))
     88           FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
     89           zcfm1(i) = zcdn(i) * FRIV
     90           FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
    8291!!$  PB          zcfh1(i) = zcdn(i) * FRIH
    83             zcfh1(i) = 0.8 * zcdn(i) * FRIH
    84             pcfm(i) = zcfm1(i)
    85             pcfh(i) = zcfh1(i)
    86           ELSE
    87             pcfm(i) = zcdn(i)* fsta(zri(i))
    88             pcfh(i) = zcdn(i)* fsta(zri(i))
    89           ENDIF
    90         ELSE                          ! situation instable
    91           IF (.NOT.zxli) THEN
    92             zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
    93                  *(1.0+zgeop(i)/(RG*rugos(i)))))
    94             zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
     92           zcfh1(i) = 0.8 * zcdn(i) * FRIH
     93           pcfm(i) = zcfm1(i)
     94           pcfh(i) = zcfh1(i)
     95        ELSE
     96           pcfm(i) = zcdn(i)* fsta(zri(i))
     97           pcfh(i) = zcdn(i)* fsta(zri(i))
     98        ENDIF
     99     ELSE                          ! situation instable
     100        IF (.NOT.zxli) THEN
     101           zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
     102                *(1.0+zgeop1(i)/(RG*rugos(i)))))
     103           zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
    95104!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
    96             zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
    97             pcfm(i) = zcfm2(i)
    98             pcfh(i) = zcfh2(i)
    99           ELSE
    100             pcfm(i) = zcdn(i)* fins(zri(i))
    101             pcfh(i) = zcdn(i)* fins(zri(i))
    102           ENDIF
    103                   zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
    104           IF(nsrf.EQ.is_oce) pcfh(i) =0.8* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
     105           zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
     106           pcfm(i) = zcfm2(i)
     107           pcfh(i) = zcfh2(i)
     108        ELSE
     109           pcfm(i) = zcdn(i)* fins(zri(i))
     110           pcfh(i) = zcdn(i)* fins(zri(i))
    105111        ENDIF
    106       END DO
    107       RETURN
    108       END SUBROUTINE clcdrag
     112        zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
     113        IF(nsrf.EQ.is_oce) pcfh(i) =0.8* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
     114     ENDIF
     115  END DO
     116
     117! ================================================================= c
     118     
     119  ! IM cf JLD : on seuille cdrag_m et cdrag_h
     120  IF (nsrf == is_oce) THEN
     121     DO i=1,knon
     122        pcfm(i)=MIN(pcfm(i),cdmmax)
     123        pcfh(i)=MIN(pcfh(i),cdhmax)
     124     END DO
     125  END IF
     126
     127END SUBROUTINE clcdrag

  • LMDZ4/trunk/libf/phylmd/clesphys.h

    r1054 r1067  
    11!
    2 ! $Header$
    32!
    43!
    … …  
    4847       REAL freq_ISCCP, ecrit_ISCCP
    4948       INTEGER :: ip_ebil_phy, iflag_rrtm
    50        LOGICAL ok_slab_sicOBS
    5149       LOGICAL :: ok_strato
    5250       LOGICAL :: ok_hines
    … …  
    6462     &     , ecrit_mth, ecrit_tra, ecrit_reg                            &
    6563     &     , freq_ISCCP, ecrit_ISCCP, ip_ebil_phy                       &
    66      &     , ok_slab_sicOBS, ok_lic_melt, cvl_corr                      &
     64     &     , ok_lic_melt, cvl_corr                                      &
    6765     &     , qsol0, iflag_rrtm, ok_strato,ok_hines,ecrit_LES
    6866     

  • LMDZ4/trunk/libf/phylmd/climb_hq_mod.F90

    r1066 r1067  
    1717  REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_H, Dcoef_H
    1818  !$OMP THREADPRIVATE(Ccoef_H, Dcoef_H)
     19  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_Q, Bcoef_Q
     20  !$OMP THREADPRIVATE(Acoef_Q, Bcoef_Q)
     21  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_H, Bcoef_H
     22  !$OMP THREADPRIVATE(Acoef_H, Bcoef_H)
    1923  REAL, DIMENSION(:,:), ALLOCATABLE :: Kcoefhq
    2024  !$OMP THREADPRIVATE(Kcoefhq)
    … …  
    2630  SUBROUTINE climb_hq_down(knon, coefhq, paprs, pplay, &
    2731       delp, temp, q, dtime, &
    28        petAcoef, peqAcoef, petBcoef, peqBcoef)
     32       Acoef_H_out, Acoef_Q_out, Bcoef_H_out, Bcoef_Q_out)
    2933
    3034    INCLUDE "YOMCST.h"
    … …  
    4549! Output arguments
    4650!****************************************************************************************
    47     REAL, DIMENSION(klon), INTENT(OUT)       :: petAcoef
    48     REAL, DIMENSION(klon), INTENT(OUT)       :: peqAcoef
    49     REAL, DIMENSION(klon), INTENT(OUT)       :: petBcoef
    50     REAL, DIMENSION(klon), INTENT(OUT)       :: peqBcoef
     51    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_H_out
     52    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_Q_out
     53    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_H_out
     54    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_Q_out
    5155
    5256! Local variables
    5357!****************************************************************************************
    54     REAL, DIMENSION(klon,klev)               :: dels, local_H
    55     REAL, DIMENSION(klon)                    :: psref, delz, pkh
     58    LOGICAL, SAVE                            :: first=.TRUE.
     59    REAL, DIMENSION(klon,klev)               :: local_H
     60    REAL, DIMENSION(klon)                    :: psref
     61    REAL                                     :: delz, pkh
    5662    INTEGER                                  :: k, i, ierr
    5763
    5864! Include
    5965!****************************************************************************************
    60   INCLUDE "compbl.h"   
     66    INCLUDE "compbl.h"   
    6167
    6268
    6369!****************************************************************************************
    6470! 1)
    65 ! Allocation
     71! Allocation at first time step only
    6672!   
    6773!****************************************************************************************
    6874
    69     ALLOCATE(Ccoef_Q(klon,klev), STAT=ierr)
    70     IF ( ierr /= 0 )  PRINT*,' pb in allloc Ccoef_Q, ierr=', ierr
    71    
    72     ALLOCATE(Dcoef_Q(klon,klev), STAT=ierr)
    73     IF ( ierr /= 0 )  PRINT*,' pb in allloc Dcoef_Q, ierr=', ierr
    74    
    75     ALLOCATE(Ccoef_H(klon,klev), STAT=ierr)
    76     IF ( ierr /= 0 )  PRINT*,' pb in allloc Ccoef_H, ierr=', ierr
    77    
    78     ALLOCATE(Dcoef_H(klon,klev), STAT=ierr)
    79     IF ( ierr /= 0 )  PRINT*,' pb in allloc Dcoef_H, ierr=', ierr
    80    
    81     ALLOCATE(Kcoefhq(klon,klev), STAT=ierr)
    82     IF ( ierr /= 0 )  PRINT*,' pb in allloc Kcoefhq, ierr=', ierr
    83    
    84     ALLOCATE(gamaq(1:klon,2:klev), STAT=ierr)
    85     IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaq, ierr=', ierr
    86    
    87     ALLOCATE(gamah(1:klon,2:klev), STAT=ierr)
    88     IF ( ierr /= 0 ) PRINT*,' pb in allloc gamah, ierr=', ierr
    89        
     75    IF (first) THEN
     76       first=.FALSE.
     77       ALLOCATE(Ccoef_Q(klon,klev), STAT=ierr)
     78       IF ( ierr /= 0 )  PRINT*,' pb in allloc Ccoef_Q, ierr=', ierr
     79       
     80       ALLOCATE(Dcoef_Q(klon,klev), STAT=ierr)
     81       IF ( ierr /= 0 )  PRINT*,' pb in allloc Dcoef_Q, ierr=', ierr
     82       
     83       ALLOCATE(Ccoef_H(klon,klev), STAT=ierr)
     84       IF ( ierr /= 0 )  PRINT*,' pb in allloc Ccoef_H, ierr=', ierr
     85       
     86       ALLOCATE(Dcoef_H(klon,klev), STAT=ierr)
     87       IF ( ierr /= 0 )  PRINT*,' pb in allloc Dcoef_H, ierr=', ierr
     88       
     89       ALLOCATE(Acoef_Q(klon), Bcoef_Q(klon), Acoef_H(klon), Bcoef_H(klon), STAT=ierr)
     90       IF ( ierr /= 0 )  PRINT*,' pb in allloc Acoef_X and Bcoef_X, ierr=', ierr
     91       
     92       ALLOCATE(Kcoefhq(klon,klev), STAT=ierr)
     93       IF ( ierr /= 0 )  PRINT*,' pb in allloc Kcoefhq, ierr=', ierr
     94       
     95       ALLOCATE(gamaq(1:klon,2:klev), STAT=ierr)
     96       IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaq, ierr=', ierr
     97       
     98       ALLOCATE(gamah(1:klon,2:klev), STAT=ierr)
     99       IF ( ierr /= 0 ) PRINT*,' pb in allloc gamah, ierr=', ierr
     100    END IF
    90101
    91102!****************************************************************************************
    … …  
    98109       DO i = 1, knon
    99110          Kcoefhq(i,k) = &
    100                coefhq(i,k)*RG /(pplay(i,k-1)-pplay(i,k)) &
     111               coefhq(i,k)*RG*RG*dtime /(pplay(i,k-1)-pplay(i,k)) &
    101112               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
    102           Kcoefhq(i,k) = Kcoefhq(i,k) * dtime*RG
    103113       ENDDO
    104114    ENDDO
    … …  
    112122    psref(:) = paprs(:,1)
    113123
    114 !   definition of start value for gama
     124!   definition of gama
    115125    IF (iflag_pbl == 1) THEN
    116126       gamaq(:,:) = 0.0
    117127       gamah(:,:) = -1.0e-03
    118128       gamah(:,2) = -2.5e-03
     129 
     130! conversion de gama
     131       DO k = 2, klev
     132          DO i = 1, knon
     133             delz = RD * (temp(i,k-1)+temp(i,k)) / &
     134                    2.0 / RG / paprs(i,k) * (pplay(i,k-1)-pplay(i,k))
     135             pkh  = (psref(i)/paprs(i,k))**RKAPPA
     136         
     137! convertie gradient verticale d'humidite specifique en difference d'humidite specifique entre centre de couches
     138             gamaq(i,k) = gamaq(i,k) * delz   
     139! convertie gradient verticale de temperature en difference de temperature potentielle entre centre de couches
     140             gamah(i,k) = gamah(i,k) * delz * RCPD * pkh
     141          ENDDO
     142       ENDDO
     143
    119144    ELSE
    120145       gamaq(:,:) = 0.0
    … …  
    122147    ENDIF
    123148   
    124 !   calculation of gama
    125     DO k = 2, klev
    126        DO i = 1, knon
    127           delz(i)  = RD * (temp(i,k-1)+temp(i,k)) / &
    128                2.0 / RG / paprs(i,k) * (pplay(i,k-1)-pplay(i,k))
    129           pkh(i) = (psref(i)/paprs(i,k))**RKAPPA
    130          
    131           gamaq(i,k) = gamaq(i,k) * delz(i)   
    132           gamah(i,k) = gamah(i,k) * delz(i) * RCPD * pkh(i)
    133        ENDDO
    134     ENDDO
    135149
    136150!****************************************************************************************   
    … …  
    139153!
    140154!****************************************************************************************
    141     dels(:,:) = delp(:,:)
    142155   
    143     CALL calc_coef(knon, Kcoefhq(:,:), gamaq(:,:), dels(:,:), q(:,:), &
    144          Ccoef_Q(:,:), Dcoef_Q(:,:))
     156    CALL calc_coef(knon, Kcoefhq(:,:), gamaq(:,:), delp(:,:), q(:,:), &
     157         Ccoef_Q(:,:), Dcoef_Q(:,:), Acoef_Q, Bcoef_Q)
    145158
    146159!****************************************************************************************
    … …  
    149162!
    150163!****************************************************************************************
    151     dels(:,:)    = 0.0
    152164    local_H(:,:) = 0.0
    153165
    154166    DO k=1,klev
    155167       DO i = 1, knon
    156 !bug          dels(i,k) = (pplay(i,k)/psref(i))**RKAPPA * delp(i,k)
    157           dels(i,k) = delp(i,k)
     168          ! convertie la temperature en entalpie potentielle
    158169          local_H(i,k) = RCPD * temp(i,k) * &
    159170               (psref(i)/pplay(i,k))**RKAPPA
    … …  
    161172    ENDDO
    162173
    163 
    164     CALL calc_coef(knon, Kcoefhq(:,:), gamah(:,:), dels(:,:), local_H(:,:), &
    165          Ccoef_H(:,:), Dcoef_H(:,:))
     174    CALL calc_coef(knon, Kcoefhq(:,:), gamah(:,:), delp(:,:), local_H(:,:), &
     175         Ccoef_H(:,:), Dcoef_H(:,:), Acoef_H, Bcoef_H)
    166176 
    167177!****************************************************************************************
    … …  
    170180!
    171181!****************************************************************************************
    172     petAcoef(1:knon) = Ccoef_H(1:knon,1)
    173     peqAcoef(1:knon) = Ccoef_Q(1:knon,1)
    174     petBcoef(1:knon) = Dcoef_H(1:knon,1)
    175     peqBcoef(1:knon) = Dcoef_Q(1:knon,1)
     182    Acoef_H_out = Acoef_H
     183    Bcoef_H_out = Bcoef_H
     184    Acoef_Q_out = Acoef_Q
     185    Bcoef_Q_out = Bcoef_Q
    176186
    177187  END SUBROUTINE climb_hq_down
    … …  
    179189!****************************************************************************************
    180190!
    181   SUBROUTINE calc_coef(knon, Kcoef, gama, dels, X, Ccoef, Dcoef)
     191  SUBROUTINE calc_coef(knon, Kcoef, gama, delp, X, Ccoef, Dcoef, Acoef, Bcoef)
    182192!
    183193! Calculate the coefficients C and D in : X(k) = C(k) + D(k)*X(k-1)
    … …  
    188198!****************************************************************************************
    189199    INTEGER, INTENT(IN)                      :: knon
    190     REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, dels
     200    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
    191201    REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
    192202    REAL, DIMENSION(klon,2:klev), INTENT(IN) :: gama
    … …  
    194204! Output arguments
    195205!****************************************************************************************
    196     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef
    197     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef
     206    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
     207    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef
    198208
    199209! Local variables
    … …  
    210220
    211221    DO i = 1, knon
    212        buf = dels(i,klev) + Kcoef(i,klev)
    213        
    214        Ccoef(i,klev) = (X(i,klev)*dels(i,klev) - Kcoef(i,klev)*gama(i,klev))/buf
     222       buf = delp(i,klev) + Kcoef(i,klev)
     223       
     224       Ccoef(i,klev) = (X(i,klev)*delp(i,klev) - Kcoef(i,klev)*gama(i,klev))/buf
    215225       Dcoef(i,klev) = Kcoef(i,klev)/buf
    216226    END DO
    … …  
    224234    DO k=(klev-1),2,-1
    225235       DO i = 1, knon
    226           buf = dels(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
    227           Ccoef(i,k) = (X(i,k)*dels(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1) + &
     236          buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
     237          Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1) + &
    228238               Kcoef(i,k+1)*gama(i,k+1) - Kcoef(i,k)*gama(i,k))/buf
    229239          Dcoef(i,k) = Kcoef(i,k)/buf
    … …  
    237247
    238248    DO i = 1, knon
    239        buf = dels(i,1) + Kcoef(i,2)*(1.-Dcoef(i,2))
    240        Ccoef(i,1) = (X(i,1)*dels(i,1) + Kcoef(i,2)*(gama(i,2)+Ccoef(i,2)))/buf
    241        Dcoef(i,1) = -1. * RG / buf
     249       buf = delp(i,1) + Kcoef(i,2)*(1.-Dcoef(i,2))
     250       Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*(gama(i,2)+Ccoef(i,2)))/buf
     251       Bcoef(i) = -1. * RG / buf
    242252    END DO
    243253
    … …  
    247257!
    248258  SUBROUTINE climb_hq_up(knon, dtime, t_old, q_old, &
    249        flx_q1, flx_t1, paprs, pplay, &
     259       flx_q1, flx_h1, paprs, pplay, &
    250260       flux_q, flux_h, d_q, d_t)
    251261!
    … …  
    262272    REAL, INTENT(IN)                         :: dtime
    263273    REAL, DIMENSION(klon,klev), INTENT(IN)   :: t_old, q_old
    264     REAL, DIMENSION(klon), INTENT(IN)        :: flx_q1, flx_t1
     274    REAL, DIMENSION(klon), INTENT(IN)        :: flx_q1, flx_h1
    265275    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
    266276    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
    … …  
    272282! Local variables
    273283!****************************************************************************************
    274     REAL, DIMENSION(klon,klev)               :: zx_pkh, zx_pkf
     284    LOGICAL, SAVE                            :: last=.FALSE.
    275285    REAL, DIMENSION(klon,klev)               :: h_new, q_new
    276286    REAL, DIMENSION(klon)                    :: psref         
    … …  
    289299    psref(1:knon) = paprs(1:knon,1) 
    290300
    291     DO k = 1, klev
    292        DO i = 1, knon
    293           zx_pkh(i,k) = (psref(i)/paprs(i,k))**RKAPPA
    294           zx_pkf(i,k) = (psref(i)/pplay(i,k))**RKAPPA
    295        END DO
    296     END DO
    297301!****************************************************************************************
    298302! 2)
    … …  
    302306
    303307!- First layer
    304     q_new(1:knon,1) = Ccoef_Q(1:knon,1) + Dcoef_Q(1:knon,1)*flx_q1(1:knon)*dtime
    305     h_new(1:knon,1) = Ccoef_H(1:knon,1) + Dcoef_H(1:knon,1)*flx_t1(1:knon)*dtime
     308    q_new(1:knon,1) = Acoef_Q(1:knon) + Bcoef_Q(1:knon)*flx_q1(1:knon)*dtime
     309    h_new(1:knon,1) = Acoef_H(1:knon) + Bcoef_H(1:knon)*flx_h1(1:knon)*dtime
    306310   
    307 !- All the rest layers
     311!- All the other layers
    308312    DO k = 2, klev
    309313       DO i = 1, knon
    … …  
    320324!- The flux at first layer, k=1
    321325    flux_q(1:knon,1)=flx_q1(1:knon)
    322     flux_h(1:knon,1)=flx_t1(1:knon)
     326    flux_h(1:knon,1)=flx_h1(1:knon)
    323327
    324328!- The flux at all layers above surface
    … …  
    329333
    330334          flux_h(i,k) = (Kcoefhq(i,k)/RG/dtime) * &
    331                (h_new(i,k)-h_new(i,k-1)+gamah(i,k)) / &
    332                zx_pkh(i,k)
     335               (h_new(i,k)-h_new(i,k-1)+gamah(i,k))
    333336       END DO
    334337    END DO
    … …  
    342345    DO k = 1, klev
    343346       DO i = 1, knon
    344           d_t(i,k) = h_new(i,k)/zx_pkf(i,k)/RCPD - t_old(i,k)
     347          d_t(i,k) = h_new(i,k)/(psref(i)/pplay(i,k))**RKAPPA/RCPD - t_old(i,k)
    345348          d_q(i,k) = q_new(i,k) - q_old(i,k)
    346349       END DO
    … …  
    351354!
    352355!****************************************************************************************
    353     DEALLOCATE(Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H,stat=ierr)   
    354     IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H, ierr=', ierr
    355     DEALLOCATE(gamaq, gamah,stat=ierr)
    356     IF ( ierr /= 0 )  PRINT*,' pb in dealllocate gamaq, gamah, ierr=', ierr
    357     DEALLOCATE(Kcoefhq,stat=ierr)
    358     IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Kcoefhq, ierr=', ierr
    359    
     356    IF (last) THEN
     357       DEALLOCATE(Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H,stat=ierr)   
     358       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H, ierr=', ierr
     359       DEALLOCATE(Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H,stat=ierr)   
     360       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H, ierr=', ierr
     361       DEALLOCATE(gamaq, gamah,stat=ierr)
     362       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate gamaq, gamah, ierr=', ierr
     363       DEALLOCATE(Kcoefhq,stat=ierr)
     364       IF ( ierr /= 0 )  PRINT*,' pb in dealllocate Kcoefhq, ierr=', ierr
     365    END IF
    360366  END SUBROUTINE climb_hq_up
    361367!
    … …  
    364370END MODULE climb_hq_mod
    365371
    366 
    367 
    368 
    369 
     372 
     373
     374
     375
     376

  • LMDZ4/trunk/libf/phylmd/climb_wind_mod.F90

    r793 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE climb_wind_mod
    … …  
    2119  REAL, DIMENSION(:,:), ALLOCATABLE  :: Ccoef_V, Dcoef_V
    2220  !$OMP THREADPRIVATE(Ccoef_V, Dcoef_V)
     21  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_U, Bcoef_U
     22  !$OMP THREADPRIVATE(Acoef_U, Bcoef_U)
     23  REAL, DIMENSION(:), ALLOCATABLE   :: Acoef_V, Bcoef_V
     24  !$OMP THREADPRIVATE(Acoef_V, Bcoef_V)
    2325  LOGICAL                            :: firstcall=.TRUE.
    2426  !$OMP THREADPRIVATE(firstcall)
    2527
    2628 
    27   PUBLIC :: climb_wind_down, calcul_wind_flux, climb_wind_up
     29  PUBLIC :: climb_wind_down, climb_wind_up
    2830
    2931CONTAINS
    … …  
    6264    IF (ierr /= 0) CALL abort_gcm(modname,'Pb in allocation Dcoef_V',1)
    6365
     66    ALLOCATE(Acoef_U(klon), Bcoef_U(klon), Acoef_V(klon), Bcoef_V(klon), STAT=ierr)
     67    IF ( ierr /= 0 )  PRINT*,' pb in allloc Acoef_U and Bcoef_U, ierr=', ierr
     68
    6469    firstcall=.FALSE.
    6570
    … …  
    6873!****************************************************************************************
    6974!
    70   SUBROUTINE climb_wind_down(knon, dtime, coef_in, pplay, paprs, temp, delp, u_old, v_old)
     75  SUBROUTINE climb_wind_down(knon, dtime, coef_in, pplay, paprs, temp, delp, u_old, v_old, &
     76       Acoef_U_out, Acoef_V_out, Bcoef_U_out, Bcoef_V_out)
    7177!
    7278! This routine calculates for the wind components u and v,
    … …  
    8894    REAL, DIMENSION(klon,klev), INTENT(IN)   :: v_old
    8995
     96! Output arguments
     97!****************************************************************************************
     98    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_U_out
     99    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_V_out
     100    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_U_out
     101    REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_V_out
     102
    90103! Local variables
    91104!****************************************************************************************
    … …  
    102115!
    103116!****************************************************************************************
    104 
    105117! - Define alpha (alf1 and alf2)
    106118    alf1(:) = 1.0
    107119    alf2(:) = 1.0 - alf1(:)
    108120
    109 ! - Calculte the wind components for the first layer
    110     u1lay(1:knon) = u_old(1:knon,1)*alf1(1:knon) + u_old(1:knon,2)*alf2(1:knon)
    111     v1lay(1:knon) = v_old(1:knon,1)*alf1(1:knon) + v_old(1:knon,2)*alf2(1:knon)   
    112 
    113 ! - Calculate K
     121! - Calculate the coefficients K
    114122    Kcoefm(:,:) = 0.0
    115     DO i = 1, knon
    116        Kcoefm(i,1) = coef_in(i,1) * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))* &
    117             pplay(i,1)/(RD*temp(i,1))
    118        Kcoefm(i,1) = Kcoefm(i,1) * dtime*RG
    119     END DO
    120 
    121123    DO k = 2, klev
    122124       DO i=1,knon
    123           Kcoefm(i,k) = coef_in(i,k)*RG/(pplay(i,k-1)-pplay(i,k)) &
     125          Kcoefm(i,k) = coef_in(i,k)*RG*RG*dtime/(pplay(i,k-1)-pplay(i,k)) &
    124126               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
    125           Kcoefm(i,k) = Kcoefm(i,k) * dtime*RG
    126127       END DO
    127128    END DO
    … …  
    130131    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
    131132         u_old(:,:), alf1(:), alf2(:),  &
    132          Ccoef_U(:,:), Dcoef_U(:,:))
     133         Ccoef_U(:,:), Dcoef_U(:,:), Acoef_U(:), Bcoef_U(:))
    133134
    134135! - Calculate the coefficients C and D, component "v"
    135136    CALL calc_coef(knon, Kcoefm(:,:), delp(:,:), &
    136137         v_old(:,:), alf1(:), alf2(:),  &
    137          Ccoef_V(:,:), Dcoef_V(:,:))
     138         Ccoef_V(:,:), Dcoef_V(:,:), Acoef_V(:), Bcoef_V(:))
     139
     140!****************************************************************************************
     141! 6)
     142! Return the first layer in output variables
     143!
     144!****************************************************************************************
     145    Acoef_U_out = Acoef_U
     146    Bcoef_U_out = Bcoef_U
     147    Acoef_V_out = Acoef_V
     148    Bcoef_V_out = Bcoef_V
    138149
    139150  END SUBROUTINE climb_wind_down
    … …  
    141152!****************************************************************************************
    142153!
    143   SUBROUTINE calc_coef(knon, Kcoef, dels, X, alfa1, alfa2, Ccoef, Dcoef)
    144 !
    145 ! Find the coefficients C and D in fonction of alfa, K and dels
     154  SUBROUTINE calc_coef(knon, Kcoef, delp, X, alfa1, alfa2, Ccoef, Dcoef, Acoef, Bcoef)
     155!
     156! Find the coefficients C and D in fonction of alfa, K and delp
    146157!
    147158! Input arguments
    148159!****************************************************************************************
    149160    INTEGER, INTENT(IN)                      :: knon
    150     REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, dels
     161    REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
    151162    REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
    152163    REAL, DIMENSION(klon), INTENT(IN)        :: alfa1, alfa2
    … …  
    154165! Output arguments
    155166!****************************************************************************************
     167    REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
    156168    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef
    157169 
    … …  
    161173    REAL                                     :: buf
    162174
     175    INCLUDE "YOMCST.h"
    163176!****************************************************************************************
    164177!
    165 ! Niveau au sommet, k=klev
     178
     179! Calculate coefficients C and D at top level, k=klev
    166180!
    167181    Ccoef(:,:) = 0.0
    … …  
    169183
    170184    DO i = 1, knon
    171        buf = dels(i,klev) + Kcoef(i,klev)
    172 
    173        Ccoef(i,klev) = X(i,klev)*dels(i,klev)/buf
     185       buf = delp(i,klev) + Kcoef(i,klev)
     186
     187       Ccoef(i,klev) = X(i,klev)*delp(i,klev)/buf
    174188       Dcoef(i,klev) = Kcoef(i,klev)/buf
    175189    END DO
    176190   
    177191!
    178 ! Niveau (klev-1) <= k <= 2
     192! Calculate coefficients C and D at top level (klev-1) <= k <= 2
    179193!
    180194    DO k=(klev-1),2,-1
    181195       DO i = 1, knon
    182           buf = dels(i,k) + Kcoef(i,k) + &
    183                Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
     196          buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
    184197         
    185           Ccoef(i,k) = X(i,k)*dels(i,k) + &
    186                Kcoef(i,k+1)*Ccoef(i,k+1)
    187           Ccoef(i,k) = Ccoef(i,k)/buf         
     198          Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1))/buf
    188199          Dcoef(i,k) = Kcoef(i,k)/buf
    189200       END DO
    190201    END DO
    191202
    192 ! 
    193 ! Niveau k=1
     203!
     204! Calculate coeffiecent A and B at surface
    194205!
    195206    DO i = 1, knon
    196        buf = dels(i,1) + &
    197             (alfa1(i) + alfa2(i)*Dcoef(i,2)) * Kcoef(i,1) + &
    198             (1.-Dcoef(i,2))*Kcoef(i,2)
    199        
    200        Ccoef(i,1) = X(i,1)*dels(i,1) + &
    201             (Kcoef(i,2)-Kcoef(i,1)*alfa2(i)) * Ccoef(i,2)
    202        Ccoef(i,1) = Ccoef(i,1)/buf
    203        Dcoef(i,1) = Kcoef(i,1)/buf
     207       buf = delp(i,1) + Kcoef(i,2)*(1-Dcoef(i,2))
     208       Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*Ccoef(i,2))/buf
     209       Bcoef(i) = -RG/buf
    204210    END DO
    205211
    … …  
    208214!****************************************************************************************
    209215!
    210   SUBROUTINE calcul_wind_flux(knon, dtime, &
    211        flux_u, flux_v)
    212 
    213     INCLUDE "YOMCST.h"
    214 
    215 ! Input arguments
    216 !****************************************************************************************
    217     INTEGER, INTENT(IN)                  :: knon
    218     REAL, INTENT(IN)                     :: dtime
    219 
    220 ! Output arguments
    221 !****************************************************************************************
    222     REAL, DIMENSION(klon), INTENT(OUT)   :: flux_u
    223     REAL, DIMENSION(klon), INTENT(OUT)   :: flux_v
    224 
    225 ! Local variables
    226 !****************************************************************************************
    227     INTEGER                              :: i
    228     REAL, DIMENSION(klon)                :: u0, v0  ! u and v at niveau 0
    229     REAL, DIMENSION(klon)                :: u1, v1  ! u and v at niveau 1
    230     REAL, DIMENSION(klon)                :: u2, v2  ! u and v at niveau 2
    231    
    232 
    233 !****************************************************************************************
    234 ! Les vents de surface sont supposes nuls
    235 !
    236 !****************************************************************************************
    237     u0(:) = 0.0
    238     v0(:) = 0.0
    239 
    240 !****************************************************************************************
    241 ! On calcule les vents du couhes 1 et 2 recurviement
    242 !
    243 !****************************************************************************************
    244     DO i = 1, knon
    245        u1(i) = Ccoef_U(i,1) + Dcoef_U(i,1)*u0(i)
    246        v1(i) = Ccoef_V(i,1) + Dcoef_V(i,1)*v0(i)
    247        u2(i) = Ccoef_U(i,2) + Dcoef_U(i,2)*u1(i)
    248        v2(i) = Ccoef_V(i,2) + Dcoef_V(i,2)*v1(i)
    249     END DO
    250 
    251 !****************************************************************************************
    252 ! On calcule le flux
    253 !
    254 !****************************************************************************************
    255     flux_u(:) = 0.0
    256     flux_v(:) = 0.0
    257 
    258     DO i=1,knon
    259        flux_u(i) = Kcoefm(i,1)/RG/dtime * (u1(i)*alf1(i) + u2(i)*alf2(i) - u0(i))
    260        flux_v(i) = Kcoefm(i,1)/RG/dtime * (v1(i)*alf1(i) + v2(i)*alf2(i) - v0(i))
    261     END DO
    262 
    263   END SUBROUTINE calcul_wind_flux
    264 !
    265 !****************************************************************************************
    266 !
    267   SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, &
     216
     217  SUBROUTINE climb_wind_up(knon, dtime, u_old, v_old, flx_u1, flx_v1,  &
    268218       flx_u_new, flx_v_new, d_u_new, d_v_new)
    269219!
    270 ! Diffuse the wind components from the surface and up to the top layer. Coefficents
    271 ! C and D are known from before. The values for U and V at surface are supposed to be
    272 ! zero (this could be modified).
    273 !
    274 ! u(k) = Cu(k) + Du(k)*u(k-1)
    275 ! v(k) = Cv(k) + Dv(k)*v(k-1)
    276 ! [1 <= k <= klev]
     220! Diffuse the wind components from the surface layer and up to the top layer.
     221! Coefficents A, B, C and D are known from before. Start values for the diffusion are the
     222! momentum fluxes at surface.
     223!
     224! u(k=1) = A + B*flx*dtime
     225! u(k)   = C(k) + D(k)*u(k-1)  [2 <= k <= klev]
    277226!
    278227!****************************************************************************************
    … …  
    285234    REAL, DIMENSION(klon,klev), INTENT(IN)  :: u_old
    286235    REAL, DIMENSION(klon,klev), INTENT(IN)  :: v_old
     236    REAL, DIMENSION(klon), INTENT(IN)       :: flx_u1, flx_v1 ! momentum flux
    287237
    288238! Output arguments
    … …  
    294244!****************************************************************************************
    295245    REAL, DIMENSION(klon,klev)              :: u_new, v_new
    296     REAL, DIMENSION(klon)                   :: u0, v0
    297246    INTEGER                                 :: k, i
    298247   
    … …  
    300249!****************************************************************************************
    301250
    302 ! Niveau 0
    303     u0(1:knon) = 0.0
    304     v0(1:knon) = 0.0
    305 
    306251! Niveau 1
    307252    DO i = 1, knon
    308        u_new(i,1) = Ccoef_U(i,1) + Dcoef_U(i,1) * u0(i)
    309        v_new(i,1) = Ccoef_V(i,1) + Dcoef_V(i,1) * v0(i)
     253       u_new(i,1) = Acoef_U(i) + Bcoef_U(i)*flx_u1(i)*dtime
     254       v_new(i,1) = Acoef_V(i) + Bcoef_V(i)*flx_v1(i)*dtime
    310255    END DO
    311256
    … …  
    329274    flx_v_new(:,:) = 0.0
    330275
    331 ! Niveau 1
    332     DO i = 1, knon
    333        flx_u_new(i,1) = Kcoefm(i,1)/RG/dtime * &
    334             (u_new(i,1)*alf1(i)+u_new(i,2)*alf2(i) - u0(i))
    335        flx_v_new(i,1) = Kcoefm(i,1)/RG/dtime * &
    336             (v_new(i,1)*alf1(i)+v_new(i,2)*alf2(i) - v0(i))
    337     END DO
     276    flx_u_new(1:knon,1)=flx_u1(1:knon)
     277    flx_v_new(1:knon,1)=flx_v1(1:knon)
    338278
    339279! Niveau 2->klev

  • LMDZ4/trunk/libf/phylmd/cltracrn.F

    r766 r1067  
    1 !
    2 ! $Header$
    31!
    42      SUBROUTINE cltracrn( itr, dtime,u1lay, v1lay,
    5      e              coef,t,ftsol,pctsrf,
     3     e              cdrag,coef,t,ftsol,pctsrf,
    64     e              tr,trs,paprs,pplay,delp,
    75     e              masktr,fshtr,hsoltr,tautr,vdeptr,
    … …  
    2624c u1lay----input-R- vent u de la premiere couche (m/s)
    2725c v1lay----input-R- vent v de la premiere couche (m/s)
    28 c coef-----input-R- le coefficient d'echange (m**2/s) l>1
     26c cdrag----input-R- cdrag
     27c coef-----input-R- le coefficient d'echange (m**2/s) l>1, valable uniquement pour k entre 2 et klev
    2928c t--------input-R- temperature (K)
    3029c paprs----input-R- pression a inter-couche (Pa)
    … …  
    5049      REAL dtime
    5150      REAL u1lay(klon), v1lay(klon)
     51      REAL cdrag(klon)
    5252      REAL coef(klon,klev)
    5353      REAL t(klon,klev), ftsol(klon,nbsrf), pctsrf(klon,nbsrf)
    … …  
    119119c======================================================================
    120120      DO i = 1, klon
    121          zx_coef(i,1) = coef(i,1)
     121         zx_coef(i,1) = cdrag(i)
    122122     .                 * (1.0+SQRT(u1lay(i)**2+v1lay(i)**2))
    123123     .                 * pplay(i,1)/(RD*t(i,1))

  • LMDZ4/trunk/libf/phylmd/coef_diff_turb_mod.F90

    r878 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE coef_diff_turb_mod
    … …  
    86! at surface(cdrag)
    97!
    10   USE dimphy
    11  
    128  IMPLICIT NONE
    139 
    … …  
    1713!
    1814  SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
    19        ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, &
     15       ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
    2016       ycoefm, ycoefh ,yq2)
    21 !
     17 
     18    USE dimphy
     19!
    2220! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the
    23 ! atmosphere and coefficients for turbulent diffusion at surface - cdrag
    24 ! (ycoefm(:,1), ycoefh(:,1)).
     21! atmosphere
     22! NB! No values are calculated between surface and the first model layer.
     23!     ycoefm(:,1) and ycoefh(:,1) are not valid !!!
    2524!
    2625!
    … …  
    3534    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yq, yt
    3635    REAL, DIMENSION(klon), INTENT(IN)          :: yts, yrugos, yqsurf
    37     REAL, DIMENSION(klon,klev+1)               :: yq2
     36    REAL, DIMENSION(klon), INTENT(IN)          :: ycdragm
     37
     38! InOutput arguments
     39!****************************************************************************************
     40    REAL, DIMENSION(klon,klev+1), INTENT(INOUT):: yq2
    3841 
    3942! Output arguments
    … …  
    4750    REAL, DIMENSION(klon,klev)                 :: ycoefm0, ycoefh0, yzlay, yteta
    4851    REAL, DIMENSION(klon,klev+1)               :: yzlev, q2diag, ykmm, ykmn, ykmq
    49     REAL, DIMENSION(klon)                      :: y_cd_h, y_cd_m
    5052    REAL, DIMENSION(klon)                      :: yustar
    5153
    … …  
    5961    INCLUDE "YOMCST.h"
    6062
    61 !****************************************************************************************
    62 ! Start calculation
    63 ! - Initilalize output variables
    64 !****************************************************************************************
    65 
    66     ycoefm(:,:) = 0.0
    67     ycoefh(:,:) = 0.0
    68 
    6963
    7064!****************************************************************************************   
    71 ! Methode 1 :
     65! Calcul de coefficients de diffusion turbulent de l'atmosphere :
     66! ycoefm(:,2:klev), ycoefh(:,2:klev)
    7267!
    7368!****************************************************************************************   
    … …  
    8075 
    8176!****************************************************************************************
    82 ! Methode 2 :
     77! Eventuelle recalcule des coeffeicients de diffusion turbulent de l'atmosphere :
     78! ycoefm(:,2:klev), ycoefh(:,2:klev)
    8379!
    8480!****************************************************************************************
    … …  
    9692    ENDIF
    9793
    98 !****************************************************************************************
    99 ! IM cf JLD : on seuille ycoefm et ycoefh
    100 !
    101 !****************************************************************************************
    102     IF (nsrf.EQ.is_oce) THEN
    103        DO j=1,knon
    104           ycoefm(j,1)=MIN(ycoefm(j,1),cdmmax)
    105           ycoefh(j,1)=MIN(ycoefh(j,1),cdhmax)
    106        ENDDO
    107     ENDIF
    10894 
    10995!**************************************************************************************** 
    … …  
    11298!****************************************************************************************
    11399    IF (ok_kzmin) THEN
    114        CALL coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycoefm, &
     100       CALL coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm, &
    115101            ycoefm0,ycoefh0)
    116102       
    … …  
    127113!****************************************************************************************
    128114! MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
    129 ! Methode 3 :
     115!
    130116!****************************************************************************************
    131117
    … …  
    159145       END DO
    160146
    161 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    162 ! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
    163 ! bug sur les coefficients de surface :
    164 !          y_cd_h(1:knon) = ycoefm(1:knon,1)
    165 !          y_cd_m(1:knon) = ycoefh(1:knon,1)
    166 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    167 
    168        y_cd_m(1:knon) = ycoefm(1:knon,1)
    169        y_cd_h(1:knon) = ycoefh(1:knon,1)
    170        
    171        CALL ustarhb(knon,yu,yv,y_cd_m, yustar)
     147!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     148!!$! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
     149!!$! bug sur les coefficients de surface :
     150!!$!          ycdragh(1:knon) = ycoefm(1:knon,1)
     151!!$!          ycdragm(1:knon) = ycoefh(1:knon,1)
     152!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     153       CALL ustarhb(knon,yu,yv,ycdragm, yustar)
    172154     
    173155       IF (prt_level > 9) THEN
    … …  
    179161          CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, &
    180162               yzlev,yzlay,yu,yv,yteta, &
    181                y_cd_m,yq2,q2diag,ykmm,ykmn,yustar, &
     163               ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
    182164               iflag_pbl)
    183165       ELSE
    184166          CALL yamada4(knon,dtime,RG,RD,ypaprs,yt, &
    185167               yzlev,yzlay,yu,yv,yteta, &
    186                y_cd_m,yq2,ykmm,ykmn,ykmq,yustar, &
     168               ycdragm,yq2,ykmm,ykmn,ykmq,yustar, &
    187169               iflag_pbl)
    188170       ENDIF
    189171       
    190        ycoefm(1:knon,1)=y_cd_m(1:knon)
    191        ycoefh(1:knon,1)=y_cd_h(1:knon)
    192172       ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
    193173       ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
    … …  
    206186       pcfm, pcfh)
    207187   
     188    USE dimphy
     189 
    208190!======================================================================
    209191! Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
    … …  
    236218!
    237219    INTEGER, INTENT(IN)                      :: knon, nsrf
     220    REAL, INTENT(IN)                         :: ksta, ksta_ter
    238221    REAL, DIMENSION(klon), INTENT(IN)        :: ts
    239     REAL, DIMENSION(klon,klev+1), INTENT(IN) ::  paprs
    240     REAL, DIMENSION(klon,klev), INTENT(IN)   ::  pplay
     222    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
     223    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
    241224    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u, v, t, q
    242225    REAL, DIMENSION(klon), INTENT(IN)        :: rugos
     226    REAL, DIMENSION(klon), INTENT(IN)        :: qsurf
    243227
    244228    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: pcfm, pcfh
    245229
    246 
    247 ! Local variables
    248 
    249 ! numero de couche du sommet de la couche limite
    250     INTEGER, DIMENSION(klon)    :: itop
     230!
     231! Local variables:
     232!
     233    INTEGER, DIMENSION(klon)    :: itop ! numero de couche du sommet de la couche limite
    251234!
    252235! Quelques constantes et options:
    253236!
    254     REAL cepdu2, ckap, cb, cc, cd, clam
    255     PARAMETER (cepdu2 =(0.1)**2)
    256     PARAMETER (CKAP=0.4)
    257     PARAMETER (cb=5.0)
    258     PARAMETER (cc=5.0)
    259     PARAMETER (cd=5.0)
    260     PARAMETER (clam=160.0)
    261     REAL ratqs ! largeur de distribution de vapeur d'eau
    262     PARAMETER (ratqs=0.05)
    263     LOGICAL richum ! utilise le nombre de Richardson humide
    264     PARAMETER (richum=.TRUE.)
    265     REAL ric ! nombre de Richardson critique
    266     PARAMETER(ric=0.4)
    267     REAL prandtl
    268     PARAMETER (prandtl=0.4)
     237    REAL, PARAMETER :: cepdu2=0.1**2
     238    REAL, PARAMETER :: CKAP=0.4
     239    REAL, PARAMETER :: cb=5.0
     240    REAL, PARAMETER :: cc=5.0
     241    REAL, PARAMETER :: cd=5.0
     242    REAL, PARAMETER :: clam=160.0
     243    REAL, PARAMETER :: ratqs=0.05 ! largeur de distribution de vapeur d'eau
     244    LOGICAL, PARAMETER :: richum=.TRUE. ! utilise le nombre de Richardson humide
     245    REAL, PARAMETER :: ric=0.4 ! nombre de Richardson critique
     246    REAL, PARAMETER :: prandtl=0.4
    269247    REAL kstable ! diffusion minimale (situation stable)
    270248    ! GKtest
    271249    ! PARAMETER (kstable=1.0e-10)
    272     REAL ksta, ksta_ter
    273250!IM: 261103     REAL kstable_ter, kstable_sinon
    274251!IM: 211003 cf GK   PARAMETER (kstable_ter = 1.0e-6)
    … …  
    277254!IM: 261103   PARAMETER (kstable_sinon = 1.0e-10)
    278255    ! fin GKtest
    279     REAL mixlen ! constante controlant longueur de melange
    280     PARAMETER (mixlen=35.0)
     256    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
    281257    INTEGER isommet ! le sommet de la couche limite
    282     LOGICAL tvirtu ! calculer Ri d'une maniere plus performante
    283     PARAMETER (tvirtu=.TRUE.)
    284     LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
    285     PARAMETER (opt_ec=.FALSE.)
     258    LOGICAL, PARAMETER :: tvirtu=.TRUE. ! calculer Ri d'une maniere plus performante
     259    LOGICAL, PARAMETER :: opt_ec=.FALSE.! formule du Centre Europeen dans l'atmosphere
    286260
    287261!
    288262! Variables locales:
    289 
    290263    INTEGER i, k !IM 120704
    291264    REAL zgeop(klon,klev)
    … …  
    293266    REAL zri(klon)
    294267    REAL zl2(klon)
    295    
    296     REAL u1(klon), v1(klon), t1(klon), q1(klon), z1(klon)
    297     REAL pcfm1(klon), pcfh1(klon)
    298 
    299268    REAL zdphi, zdu2, ztvd, ztvu, zcdn
    300269    REAL zscf
    301270    REAL zt, zq, zdelta, zcvm5, zcor, zqs, zfr, zdqs
    302271    REAL z2geomf, zalh2, zalm2, zscfh, zscfm
    303     REAL t_coup
    304     PARAMETER (t_coup=273.15)
    305 !IM
    306     LOGICAL check
    307     PARAMETER (check=.FALSE.)
     272    REAL, PARAMETER :: t_coup=273.15
     273    LOGICAL, PARAMETER :: check=.FALSE.
    308274!
    309275! contre-gradient pour la chaleur sensible: Kelvin/metre
    310276    REAL gamt(2:klev)
    311     REAL qsurf(klon)
    312 
    313     LOGICAL, SAVE :: appel1er
     277
     278    LOGICAL, SAVE :: appel1er=.TRUE.
    314279    !$OMP THREADPRIVATE(appel1er)
    315280!
    316281! Fonctions thermodynamiques et fonctions d'instabilite
    317282    REAL fsta, fins, x
    318     LOGICAL zxli ! utiliser un jeu de fonctions simples
    319     PARAMETER (zxli=.FALSE.)
    320283
    321284    fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
    322285    fins(x) = SQRT(1.0-18.0*x)
    323 
    324     DATA appel1er /.TRUE./
    325 
    326286
    327287    isommet=klev
    … …  
    388348    ENDDO
    389349
    390 !
    391 ! Calculer le frottement au sol (Cdrag)
    392 !
    393     DO i = 1, knon
    394        u1(i) = u(i,1)
    395        v1(i) = v(i,1)
    396        t1(i) = t(i,1)
    397        q1(i) = q(i,1)
    398        z1(i) = zgeop(i,1)
    399     ENDDO
    400 
    401     CALL clcdrag(klon, knon, nsrf, zxli, &
    402          u1, v1, t1, q1, z1, &
    403          ts, qsurf, rugos, &
    404          pcfm1, pcfh1)
    405 !IM               ts, qsurf, rugos,
    406 
    407     DO i = 1, knon
    408        pcfm(i,1)=pcfm1(i)
    409        pcfh(i,1)=pcfh1(i)
    410     ENDDO
    411350!
    412351! Calculer les coefficients turbulents dans l'atmosphere
    … …  
    535474       pcfm, pcfh)
    536475
     476    USE dimphy
     477
    537478!======================================================================
    538479! J'introduit un peu de diffusion sauf dans les endroits
    … …  
    562503! Quelques constantes et options:
    563504!
    564     REAL prandtl
    565     PARAMETER (prandtl=0.4)
    566     REAL kstable
    567     PARAMETER (kstable=0.002)
    568 !    PARAMETER (kstable=0.001)
    569     REAL mixlen ! constante controlant longueur de melange
    570     PARAMETER (mixlen=35.0)
    571     REAL seuil ! au-dela l'inversion est consideree trop faible
    572     PARAMETER (seuil=-0.02)
     505    REAL, PARAMETER :: prandtl=0.4
     506    REAL, PARAMETER :: kstable=0.002
     507!   REAL, PARAMETER :: kstable=0.001
     508    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
     509    REAL, PARAMETER :: seuil=-0.02 ! au-dela l'inversion est consideree trop faible
    573510!    PARAMETER (seuil=-0.04)
    574511!    PARAMETER (seuil=-0.06)

  • LMDZ4/trunk/libf/phylmd/coefkzmin.F

    r782 r1067  
    11!
    2 ! $Header$
    3 !
    4        SUBROUTINE coefkzmin(ngrid,ypaprs,ypplay,yu,yv,yt,yq,ycoefm
     2       SUBROUTINE coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm
    53     .   ,km,kn)
    6 c      SUBROUTINE coefkzmin(ngrid,zlev,teta,ustar,km,kn)
     4
    75      USE dimphy
    86      IMPLICIT NONE
    … …  
    1412c  disponibles.
    1513
    16       REAL  ycoefm(klon,klev)
     14      REAL  ycdragm(klon)
    1715
    1816      REAL yu(klon,klev), yv(klon,klev)
    … …  
    5452      REAL km(klon,klev+1)
    5553      REAL kn(klon,klev+1)
    56       integer ngrid
     54      integer knon
    5755
    5856
    … …  
    6967c  Debut de la partie qui doit etre unclue a terme dans clmain.
    7068c
    71          do i=1,ngrid
     69         do i=1,knon
    7270            yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1)))
    7371     .                *(ypaprs(i,1)-ypplay(i,1))/RG
    7472         enddo
    7573         do k=2,klev
    76             do i=1,ngrid
     74            do i=1,knon
    7775               yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k))
    7876     s                /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
    … …  
    8078         enddo
    8179         do k=1,klev
    82             do i=1,ngrid
     80            do i=1,knon
    8381cATTENTION:on passe la temperature potentielle virt. pour le calcul de K
    8482             yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa
    … …  
    8684            enddo
    8785         enddo
    88          do i=1,ngrid
     86         do i=1,knon
    8987            yzlev(i,1)=0.
    9088            yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1)
    9189         enddo
    9290         do k=2,klev
    93             do i=1,ngrid
     91            do i=1,knon
    9492               yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
    9593            enddo
    9694         enddo
    9795
    98 
    99 cIM cf FH   yustar(:) =SQRT(ycoefm(:,1)*(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1)))
    100       yustar(1:ngrid) =SQRT(ycoefm(1:ngrid,1)*
    101      $       (yu(1:ngrid,1)*yu(1:ngrid,1)+yv(1:ngrid,1)*yv(1:ngrid,1)))
     96      yustar(1:knon) =SQRT(ycdragm(1:knon)*
     97     $       (yu(1:knon,1)*yu(1:knon,1)+yv(1:knon,1)*yv(1:knon,1)))
    10298
    10399c  Fin de la partie qui doit etre unclue a terme dans clmain.
    … …  
    114110      zlev=yzlev
    115111
    116       do ig=1,ngrid
    117       coriol(ig)=1.e-4
    118       pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
     112      do ig=1,knon
     113         coriol(ig)=1.e-4
     114         pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
    119115      enddo
    120      
     116         
    121117      do k=2,klev
    122          do ig=1,ngrid
     118         do ig=1,knon
    123119            if (teta(ig,2).gt.teta(ig,1)) then
    124120               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r1010 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE cpl_mod
    … …  
    6765  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_alb_sic ! albedo at sea ice
    6866  !$OMP THREADPRIVATE(read_alb_sic)
     67  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_u0, read_v0 ! ocean surface current
     68  !$OMP THREADPRIVATE(read_u0,read_v0)
    6969 
    7070  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: unity
    … …  
    177177    sum_error = sum_error + error
    178178    ALLOCATE(read_alb_sic(iim, jj_nb), stat = error)
     179    sum_error = sum_error + error
     180
     181    ALLOCATE(read_u0(iim, jj_nb), stat = error)
     182    sum_error = sum_error + error
     183    ALLOCATE(read_v0(iim, jj_nb), stat = error)
    179184    sum_error = sum_error + error
    180185
    … …  
    272277! are stored in this module.
    273278    USE surface_data
     279    USE phys_state_var_mod, ONLY : rlon, rlat
     280    USE Write_Field
    274281
    275282    INCLUDE "indicesol.h"
    … …  
    296303    REAL, DIMENSION(iim,jj_nb,jpfldo2a)     :: tab_read_flds
    297304    REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
     305    REAL, DIMENSION(klon_mpi)               :: rlon_mpi, rlat_mpi
     306    REAL, DIMENSION(iim, jj_nb)             :: tmp_lon, tmp_lat
     307    REAL, DIMENSION(iim, jj_nb)             :: tmp_r0
    298308
    299309!*************************************************************************************
    … …  
    311321       time_sec=(itime-1)*dtime
    312322#ifdef CPP_COUPLE
    313     time_sec=(itime-1)*dtime
    314323!$OMP MASTER
    315324    CALL fromcpl(time_sec, tab_read_flds)
    … …  
    342351!$OMP END MASTER
    343352
     353       IF (cpl_current) THEN
     354
     355! Transform the longitudes and latitudes on 2D arrays
     356          CALL gather_omp(rlon,rlon_mpi)
     357          CALL gather_omp(rlat,rlat_mpi)
     358!$OMP MASTER
     359          CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
     360          CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
     361
     362! Transform the currents from cartesian to spheric coordinates
     363! tmp_r0 should be zero
     364          CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,5), tab_read_flds(:,:,6), tab_read_flds(:,:,7), &
     365               tmp_lon, tmp_lat, &
     366               read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
     367!$OMP END MASTER
     368          CALL WriteField('read_u0',read_u0)
     369          CALL WriteField('read_v0',read_v0)
     370          CALL WriteField('read_r0',tmp_r0)
     371       ELSE
     372          read_u0(:,:) = 0.
     373          read_v0(:,:) = 0.
     374       ENDIF
     375
    344376!*************************************************************************************
    345377!  Transform seaice fraction (read_sic : ocean-seaice mask) into global
    … …  
    368400!
    369401
    370   SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new)
     402  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, v0_new)
    371403!
    372404! This routine returns the field for the ocean that has been read from the coupler
    … …  
    384416!*************************************************************************************
    385417    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
     418    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
     419    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
    386420
    387421! Local variables
    … …  
    396430    CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
    397431    CALL cpl2gath(read_sic, sic_new, knon, knindex)
     432    CALL cpl2gath(read_u0, u0_new, knon, knindex)
     433    CALL cpl2gath(read_v0, v0_new, knon, knindex)
    398434
    399435!*************************************************************************************
    … …  
    11201156    ENDIF
    11211157
    1122 ! Transform the wind from local atmospheric 2D coordinates to geocentric
    1123 ! 3D coordinates
     1158! Transform the wind from spherical atmospheric 2D coordinates to geocentric
     1159! cartesian 3D coordinates
    11241160!$OMP MASTER
    11251161    CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
    … …  
    11651201    time_sec=(itime-1)*dtime
    11661202#ifdef CPP_COUPLE
    1167     time_sec=(itime-1)*dtime
    11681203!$OMP MASTER
    11691204    CALL intocpl(time_sec, lafin, tab_flds(:,:,:))

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r1001 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE oasis
    … …  
    3230  INTEGER, PARAMETER  :: jpflda2o2=6
    3331! Number of fields exchanged from ocean to atmosphere
    34   INTEGER, PARAMETER  :: jpfldo2a=4
     32  INTEGER  :: jpfldo2a
    3533
    3634  CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE   :: cl_read
    … …  
    3937  !$OMP THREADPRIVATE(cl_writ)
    4038
    41   INTEGER, DIMENSION(jpfldo2a), SAVE, PRIVATE            :: in_var_id
     39  INTEGER, DIMENSION(jpmaxfld), SAVE, PRIVATE            :: in_var_id
    4240  !$OMP THREADPRIVATE(in_var_id)
    4341  INTEGER, DIMENSION(jpflda2o1+jpflda2o2), SAVE, PRIVATE :: out_var_id
    4442  !$OMP THREADPRIVATE(out_var_id)
    4543
    46   CHARACTER(LEN=*),PARAMETER :: OPA_version='OPA9'
     44  LOGICAL :: cpl_current
    4745
    4846#ifdef CPP_COUPLE
    … …  
    5856!     LF 09/2003
    5957!
     58    USE IOIPSL
    6059    USE surface_data, ONLY : version_ocean
    6160    INCLUDE "dimensions.h"
    … …  
    7574    CHARACTER (len = 20)               :: modname = 'inicma'
    7675    CHARACTER (len = 80)               :: abort_message
     76    LOGICAL                            :: cpl_current_omp
    7777
    7878!*    1. Initializations
    … …  
    9090!
    9191    clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
    92 !
     92
     93!************************************************************************************
     94! Define if coupling ocean currents or not
     95!************************************************************************************
     96!$OMP MASTER
     97    cpl_current_omp = .FALSE.
     98    CALL getin('cpl_current', cpl_current_omp)
     99!$OMP END MASTER
     100!$OMP BARRIER
     101    cpl_current = cpl_current_omp
     102    WRITE(nuout,*) 'Couple ocean currents, cpl_current = ',cpl_current
     103
     104    IF (cpl_current) THEN
     105       jpfldo2a=7
     106    ELSE
     107       jpfldo2a=4
     108    END IF
    93109!************************************************************************************
    94110! Here we go: psmile initialisation
    … …  
    183199       cl_read(4)='SIICTEMW'
    184200    END IF
     201    cl_read(5)='CURRENTX'
     202    cl_read(6)='CURRENTY'
     203    cl_read(7)='CURRENTZ'
    185204
    186205    il_var_nodims(1) = 2

  • LMDZ4/trunk/libf/phylmd/ocean_cpl_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE ocean_cpl_mod
    … …  
    86!
    97
    10   USE dimphy,           ONLY : klon
    11   USE cpl_mod
    12   USE calcul_fluxs_mod, ONLY : calcul_fluxs
    13   USE climb_wind_mod,   ONLY : calcul_wind_flux
    14 
    158  IMPLICIT NONE
    169  PRIVATE
    … …  
    2821! Allocate fields for this module and initailize the module mod_cpl
    2922!
     23    USE dimphy,           ONLY : klon
     24    USE cpl_mod
     25
    3026! Input arguments
    3127!*************************************************************************************
    … …  
    4844  SUBROUTINE ocean_cpl_noice( &
    4945       swnet, lwnet, alb1, &
    50        windsp, &
    51        fder_old, &
     46       windsp, fder_old, &
    5247       itime, dtime, knon, knindex, &
    53        p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    54        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    55        ps, u1_lay, v1_lay, &
     48       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     49       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     50       AcoefU, AcoefV, BcoefU, BcoefV, &
     51       ps, u1, v1, &
    5652       radsol, snow, agesno, &
    57        qsurf, evap, fluxsens, fluxlat, &
     53       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    5854       tsurf_new, dflux_s, dflux_l)
     55
    5956!
    6057! This subroutine treats the "open ocean", all grid points that are not entierly covered
    … …  
    6259! surface is done and finally it sends some fields to the coupler.
    6360!
     61    USE dimphy,           ONLY : klon
     62    USE cpl_mod
     63    USE calcul_fluxs_mod
     64
    6465    INCLUDE "indicesol.h"
    6566    INCLUDE "YOMCST.h"
    … …  
    7677    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
    7778    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    78     REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
     79    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
    7980    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    8081    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    81     REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
    82     REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
     82    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
     83    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    8384    REAL, DIMENSION(klon), INTENT(IN)        :: ps
    84     REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
     85    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
    8586
    8687! In/Output arguments
    … …  
    9495    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
    9596    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
     97    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    9698    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    9799    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    … …  
    104106    REAL, DIMENSION(klon) :: fder_new
    105107    REAL, DIMENSION(klon) :: tsurf_cpl
    106     REAL, DIMENSION(klon) :: taux, tauy
     108    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
     109    REAL, DIMENSION(klon) :: u1_lay, v1_lay
    107110    LOGICAL               :: check=.FALSE.
    108111
    … …  
    116119!
    117120!****************************************************************************************
    118     CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl)
     121    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
    119122
    120123!****************************************************************************************
    … …  
    126129    dif_grnd = 0.
    127130    agesno(:) = 0.
    128    
     131
     132    DO i = 1, knon
     133       u1_lay(i) = u1(i) - u0_cpl(i)
     134       v1_lay(i) = v1(i) - v0_cpl(i)
     135    END DO
     136
    129137    CALL calcul_fluxs(knon, is_oce, dtime, &
    130          tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
     138         tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
    131139         precip_rain, precip_snow, snow, qsurf,  &
    132140         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    133          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     141         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    134142         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    135143   
    136     ! Calcultate the flux of u and v at surface
    137     CALL calcul_wind_flux(knon, dtime, taux, tauy)
    138    
     144! - Flux calculation at first modele level for U and V
     145    CALL calcul_flux_wind(knon, dtime, &
     146         u0_cpl, v0_cpl, u1, v1, cdragm, &
     147         AcoefU, AcoefV, BcoefU, BcoefV, &
     148         p1lay, temp_air, &
     149         flux_u1, flux_v1) 
    139150
    140151!****************************************************************************************
    … …  
    159170    CALL cpl_send_ocean_fields(itime, knon, knindex, &
    160171         swnet, lwnet, fluxlat, fluxsens, &
    161          precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy, windsp)
     172         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp)
    162173   
    163174
    … …  
    171182       itime, dtime, knon, knindex, &
    172183       lafin, &
    173        p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    174        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    175        ps, u1_lay, v1_lay, pctsrf, &
     184       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     185       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     186       AcoefU, AcoefV, BcoefU, BcoefV, &
     187       ps, u1, v1, pctsrf, &
    176188       radsol, snow, qsurf, &
    177        alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     189       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    178190       tsurf_new, dflux_s, dflux_l)
    179191!
    … …  
    182194! some fields to the coupler.
    183195!   
     196    USE dimphy,           ONLY : klon
     197    USE cpl_mod
     198    USE calcul_fluxs_mod
     199
    184200    INCLUDE "indicesol.h"
    185201    INCLUDE "YOMCST.h"
    … …  
    197213    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
    198214    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    199     REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
     215    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
    200216    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    201217    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    202     REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
    203     REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
     218    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
     219    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    204220    REAL, DIMENSION(klon), INTENT(IN)        :: ps
    205     REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
     221    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
    206222    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    207223
    … …  
    216232    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
    217233    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
     234    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    218235    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    219236    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    … …  
    227244    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
    228245    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
    229     REAL, DIMENSION(klon)   :: taux, tauy
    230246    REAL, DIMENSION(klon)   :: alb_cpl
     247    REAL, DIMENSION(klon)   :: u0, v0
     248    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
    231249
    232250! End definitions
    … …  
    255273    beta = 1.0
    256274   
     275! Suppose zero surface speed
     276    u0(:)=0.0
     277    v0(:)=0.0
     278    u1_lay(:) = u1(:) - u0(:)
     279    v1_lay(:) = v1(:) - v0(:)
    257280
    258281    CALL calcul_fluxs(knon, is_sic, dtime, &
    259          tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
     282         tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
    260283         precip_rain, precip_snow, snow, qsurf,  &
    261284         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    262          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     285         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    263286         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    264287
    265     ! Calcultate the flux of u and v at surface
    266     CALL calcul_wind_flux(knon, dtime, taux, tauy)
    267    
    268    
     288
     289! - Flux calculation at first modele level for U and V
     290    CALL calcul_flux_wind(knon, dtime, &
     291         u0, v0, u1, v1, cdragm, &
     292         AcoefU, AcoefV, BcoefU, BcoefV, &
     293         p1lay, temp_air, &
     294         flux_u1, flux_v1) 
     295
    269296!****************************************************************************************
    270297! Calculate fder : flux derivative (sensible and latente)
    … …  
    289316       pctsrf, lafin, rlon, rlat, &
    290317       swnet, lwnet, fluxlat, fluxsens, &
    291        precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy)
     318       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1)
    292319 
    293320

  • LMDZ4/trunk/libf/phylmd/ocean_forced_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE ocean_forced_mod
    … …  
    75! forced ocean,  "ocean=force".
    86!
    9   USE surface_data,     ONLY : calice, calsno, tau_gl
    10   USE fonte_neige_mod,  ONLY : fonte_neige
    11   USE calcul_fluxs_mod, ONLY : calcul_fluxs
    12   USE dimphy
    13 
    147  IMPLICIT NONE
    158
    … …  
    1811!****************************************************************************************
    1912!
    20   SUBROUTINE ocean_forced_noice(itime, dtime, jour, knon, knindex, &
    21        debut, &
    22        p1lay, tq_cdrag, precip_rain, precip_snow, &
     13  SUBROUTINE ocean_forced_noice( &
     14       itime, dtime, jour, knon, knindex, &
     15       p1lay, cdragh, cdragm, precip_rain, precip_snow, &
    2316       temp_air, spechum, &
    24        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    25        ps, u1_lay, v1_lay, &
     17       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     18       AcoefU, AcoefV, BcoefU, BcoefV, &
     19       ps, u1, v1, &
    2620       radsol, snow, agesno, &
    27        qsurf, evap, fluxsens, fluxlat, &
     21       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    2822       tsurf_new, dflux_s, dflux_l)
    2923!
    … …  
    3327! surface.
    3428!
     29    USE dimphy
     30    USE calcul_fluxs_mod
    3531    USE limit_read_mod
    3632    INCLUDE "indicesol.h"
    … …  
    4137    INTEGER, INTENT(IN)                      :: itime, jour, knon
    4238    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
    43     LOGICAL, INTENT(IN)                      :: debut
    4439    REAL, INTENT(IN)                         :: dtime
    4540    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    46     REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
     41    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
    4742    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    4843    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    49     REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
    50     REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
     44    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
     45    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    5146    REAL, DIMENSION(klon), INTENT(IN)        :: ps
    52     REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
     47    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
    5348
    5449! In/Output arguments
    … …  
    6257    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
    6358    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
     59    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    6460    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    6561    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l
    … …  
    7066    REAL, DIMENSION(klon)       :: cal, beta, dif_grnd
    7167    REAL, DIMENSION(klon)       :: alb_neig, tsurf_lim, zx_sl
     68    REAL, DIMENSION(klon)       :: u0, v0
     69    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
    7270    LOGICAL                     :: check=.FALSE.
    7371
    … …  
    7674!****************************************************************************************
    7775    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
    78 
     76   
    7977!****************************************************************************************
    8078! 1)   
    … …  
    9593    alb_neig(:) = 0.
    9694    agesno(:) = 0.
    97  
     95! Suppose zero surface speed
     96    u0(:)=0.0
     97    v0(:)=0.0
     98    u1_lay(:) = u1(:) - u0(:)
     99    v1_lay(:) = v1(:) - v0(:)
     100
    98101! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
    99102    CALL calcul_fluxs(knon, is_oce, dtime, &
    100          tsurf_lim, p1lay, cal, beta, tq_cdrag, ps, &
     103         tsurf_lim, p1lay, cal, beta, cdragh, ps, &
    101104         precip_rain, precip_snow, snow, qsurf,  &
    102105         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    103          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     106         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    104107         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    105108
     109! - Flux calculation at first modele level for U and V
     110    CALL calcul_flux_wind(knon, dtime, &
     111         u0, v0, u1, v1, cdragm, &
     112         AcoefU, AcoefV, BcoefU, BcoefV, &
     113         p1lay, temp_air, &
     114         flux_u1, flux_v1) 
    106115
    107116  END SUBROUTINE ocean_forced_noice
    108117!
    109 !****************************************************************************************
    110 !
    111   SUBROUTINE ocean_forced_ice(itime, dtime, jour, knon, knindex, &
    112        debut, &
    113        tsurf_in, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    114        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    115        ps, u1_lay, v1_lay, &
     118!***************************************************************************************
     119!
     120  SUBROUTINE ocean_forced_ice( &
     121       itime, dtime, jour, knon, knindex, &
     122       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     123       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     124       AcoefU, AcoefV, BcoefU, BcoefV, &
     125       ps, u1, v1, &
    116126       radsol, snow, qsol, agesno, tsoil, &
    117        qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     127       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    118128       tsurf_new, dflux_s, dflux_l)
    119129!
    … …  
    122132! surface.
    123133!
     134    USE dimphy
     135    USE calcul_fluxs_mod
     136    USE surface_data,     ONLY : calice, calsno, tau_gl
    124137    USE limit_read_mod
     138    USE fonte_neige_mod,  ONLY : fonte_neige
    125139
    126140    INCLUDE "indicesol.h"
    … …  
    133147    INTEGER, INTENT(IN)                  :: itime, jour, knon
    134148    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
    135     LOGICAL, INTENT(IN)                  :: debut
    136149    REAL, INTENT(IN)                     :: dtime
    137150    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
    138151    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
    139     REAL, DIMENSION(klon), INTENT(IN)    :: tq_cdrag
     152    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
    140153    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
    141154    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
    142     REAL, DIMENSION(klon), INTENT(IN)    :: petAcoef, peqAcoef
    143     REAL, DIMENSION(klon), INTENT(IN)    :: petBcoef, peqBcoef
     155    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
     156    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
    144157    REAL, DIMENSION(klon), INTENT(IN)    :: ps
    145     REAL, DIMENSION(klon), INTENT(IN)    :: u1_lay, v1_lay
     158    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
    146159
    147160! In/Output arguments
    … …  
    158171    REAL, DIMENSION(klon), INTENT(OUT)            :: alb2_new  ! new albedo in near IR interval
    159172    REAL, DIMENSION(klon), INTENT(OUT)            :: evap, fluxsens, fluxlat
     173    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
    160174    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
    161175    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
    … …  
    170184    REAL, DIMENSION(klon)       :: alb_neig, tsurf_tmp
    171185    REAL, DIMENSION(klon)       :: soilcap, soilflux
     186    REAL, DIMENSION(klon)       :: u0, v0
     187    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
    172188
    173189!****************************************************************************************
    … …  
    178194!****************************************************************************************
    179195! 1)
    180 ! Flux calculation : tsurf_new, evap, fluxlat, fluxsens,
     196! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
    181197!                    dflux_s, dflux_l and qsurf
    182198!****************************************************************************************
    … …  
    200216
    201217    beta = 1.0
     218! Suppose zero surface speed
     219    u0(:)=0.0
     220    v0(:)=0.0
     221    u1_lay(:) = u1(:) - u0(:)
     222    v1_lay(:) = v1(:) - v0(:)
    202223    CALL calcul_fluxs(knon, is_sic, dtime, &
    203          tsurf_tmp, p1lay, cal, beta, tq_cdrag, ps, &
     224         tsurf_tmp, p1lay, cal, beta, cdragh, ps, &
    204225         precip_rain, precip_snow, snow, qsurf,  &
    205226         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    206          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     227         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    207228         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     229
     230! - Flux calculation at first modele level for U and V
     231    CALL calcul_flux_wind(knon, dtime, &
     232         u0, v0, u1, v1, cdragm, &
     233         AcoefU, AcoefV, BcoefU, BcoefV, &
     234         p1lay, temp_air, &
     235         flux_u1, flux_v1) 
    208236
    209237!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/ocean_slab_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE ocean_slab_mod
    … …  
    75! "ocean=slab".
    86!
    9   USE surface_data
    10   USE fonte_neige_mod,  ONLY : fonte_neige
    11   USE calcul_fluxs_mod, ONLY : calcul_fluxs
    12   USE dimphy
    13  
    147  IMPLICIT NONE
    158  PRIVATE
    … …  
    2215  SUBROUTINE ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified)
    2316
     17    USE dimphy
    2418    USE limit_read_mod
     19    USE surface_data
    2520    INCLUDE "indicesol.h"
    2621!    INCLUDE "clesphys.h"
    … …  
    4035
    4136
    42     IF (version_ocean=='sicOBS') THEN   
     37    IF (version_ocean == 'sicOBS') THEN   
    4338       CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified)
    4439    ELSE
    … …  
    5550  SUBROUTINE ocean_slab_noice( &
    5651       itime, dtime, jour, knon, knindex, &
    57        p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    58        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    59        ps, u1_lay, v1_lay, tsurf_in, &
     52       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     53       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     54       AcoefU, AcoefV, BcoefU, BcoefV, &
     55       ps, u1, v1, tsurf_in, &
    6056       radsol, snow, agesno, &
    61        qsurf, evap, fluxsens, fluxlat, &
     57       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    6258       tsurf_new, dflux_s, dflux_l, lmt_bils)
    63 
     59   
     60    USE dimphy
     61    USE calcul_fluxs_mod
     62 
    6463    INCLUDE "indicesol.h"
    6564    INCLUDE "iniprint.h"
    … …  
    7372    REAL, INTENT(IN)                     :: dtime
    7473    REAL, DIMENSION(klon), INTENT(IN)    :: p1lay
    75     REAL, DIMENSION(klon), INTENT(IN)    :: tq_cdrag
     74    REAL, DIMENSION(klon), INTENT(IN)    :: cdragh, cdragm
    7675    REAL, DIMENSION(klon), INTENT(IN)    :: precip_rain, precip_snow
    7776    REAL, DIMENSION(klon), INTENT(IN)    :: temp_air, spechum
    78     REAL, DIMENSION(klon), INTENT(IN)    :: petAcoef, peqAcoef
    79     REAL, DIMENSION(klon), INTENT(IN)    :: petBcoef, peqBcoef
     77    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefH, AcoefQ, BcoefH, BcoefQ
     78    REAL, DIMENSION(klon), INTENT(IN)    :: AcoefU, AcoefV, BcoefU, BcoefV
    8079    REAL, DIMENSION(klon), INTENT(IN)    :: ps
    81     REAL, DIMENSION(klon), INTENT(IN)    :: u1_lay, v1_lay
     80    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1
    8281    REAL, DIMENSION(klon), INTENT(IN)    :: tsurf_in
    8382
    … …  
    9291    REAL, DIMENSION(klon), INTENT(OUT)   :: qsurf
    9392    REAL, DIMENSION(klon), INTENT(OUT)   :: evap, fluxsens, fluxlat
     93    REAL, DIMENSION(klon), INTENT(OUT)   :: flux_u1, flux_v1
    9494    REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new
    9595    REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l     
    … …  
    101101    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
    102102    REAL, DIMENSION(klon) :: lmt_bils_oce, lmt_foce, diff_sst
     103    REAL, DIMENSION(klon) :: u0, v0
     104    REAL, DIMENSION(klon) :: u1_lay, v1_lay
    103105    REAL                  :: calc_bils_oce, deltat
    104106    REAL, PARAMETER       :: cyang=50.0 * 4.228e+06 ! capacite calorifique volumetrique de l'eau J/(m2 K)
    … …  
    113115    agesno(:)   = 0.
    114116   
     117! Suppose zero surface speed
     118    u0(:)=0.0
     119    v0(:)=0.0
     120    u1_lay(:) = u1(:) - u0(:)
     121    v1_lay(:) = v1(:) - v0(:)
     122
    115123    CALL calcul_fluxs(knon, is_oce, dtime, &
    116          tsurf_in, p1lay, cal, beta, tq_cdrag, ps, &
     124         tsurf_in, p1lay, cal, beta, cdragh, ps, &
    117125         precip_rain, precip_snow, snow, qsurf,  &
    118126         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    119          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     127         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    120128         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
     129
     130! - Flux calculation at first modele level for U and V
     131    CALL calcul_flux_wind(knon, dtime, &
     132         u0, v0, u1, v1, cdragm, &
     133         AcoefU, AcoefV, BcoefU, BcoefV, &
     134         p1lay, temp_air, &
     135         flux_u1, flux_v1) 
    121136
    122137!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90

    r1064 r1067  
    388388    REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
    389389    REAL, DIMENSION(klon)              :: y_dflux_t, y_dflux_q
    390     REAL, DIMENSION(klon)              :: u1lay, v1lay
     390    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
    391391    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
    392392    REAL, DIMENSION(klon)              :: yustar
    393     REAL, DIMENSION(klon)              :: yu10mx
    394     REAL, DIMENSION(klon)              :: yu10my
    395393    REAL, DIMENSION(klon)              :: ywindsp
    396394    REAL, DIMENSION(klon)              :: yt10m, yq10m
    … …  
    411409    REAL, DIMENSION(klon)              :: rugo1
    412410    REAL, DIMENSION(klon)              :: yfluxsens
    413     REAL, DIMENSION(klon)              :: petAcoef, peqAcoef, petBcoef, peqBcoef
     411    REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
     412    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
    414413    REAL, DIMENSION(klon)              :: ypsref
    415414    REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb1_new, yalb2_new
    … …  
    421420    REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
    422421    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm
     422    REAL, DIMENSION(klon)              :: ycdragh, ycdragm
    423423    REAL, DIMENSION(klon,klev)         :: yu, yv
    424424    REAL, DIMENSION(klon,klev)         :: yt, yq
    … …  
    451451    REAL, DIMENSION(klon,nbsrf)        :: trmb2        ! inhibition
    452452    REAL, DIMENSION(klon,nbsrf)        :: trmb3        ! point Omega
     453    REAL, DIMENSION(klon,nbsrf)        :: zx_rh2m, zx_qsat2m
    453454    REAL, DIMENSION(klon,nbsrf)        :: zx_t1
    454455    REAL, DIMENSION(klon, nbsrf)       :: alb          ! mean albedo for whole SW interval
    … …  
    461462  REAL  :: fsens,flat
    462463  LOGICAL ok_flux_surf
    463   data ok_flux_surf/.false./
     464  DATA ok_flux_surf/.FALSE./
    464465!ym pas glop !!
    465     common /flux_arp/fsens,flat,ok_flux_surf
     466  COMMON /flux_arp/fsens,flat,ok_flux_surf
    466467!$OMP THREADPRIVATE(/flux_arp/)
    467468
    … …  
    476477!
    477478!****************************************************************************************
    478 
    479479
    480480    IF (first_call) THEN
    … …  
    515515! Force soil water content to qsol0 if qsol0>0 and VEGET=F (use bucket
    516516! instead of ORCHIDEE)
    517     if (qsol0>0.) then
    518       print*,'WARNING : On impose qsol=',qsol0
     517    IF (qsol0>0.) THEN
     518      PRINT*,'WARNING : On impose qsol=',qsol0
    519519      qsol(:)=qsol0
    520     endif
     520    ENDIF
    521521!****************************************************************************************
    522522
    … …  
    527527!****************************************************************************************
    528528    cdragh = 0.0  ; cdragm = 0.0     ; dflux_t = 0.0   ; dflux_q = 0.0
    529     ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0     ; zu1 = 0.0       
     529    ypct = 0.0    ; yts = 0.0        ; ysnow = 0.0
    530530    zv1 = 0.0     ; yqsurf = 0.0     ; yalb1 = 0.0     ; yalb2 = 0.0   
    531531    yrain_f = 0.0 ; ysnow_f = 0.0    ; yfder = 0.0     ; ysolsw = 0.0   
    … …  
    534534    ydelp = 0.0   ; yu = 0.0         ; yv = 0.0        ; yt = 0.0         
    535535    yq = 0.0      ; y_dflux_t = 0.0  ; y_dflux_q = 0.0
    536     yrugoro = 0.0 ; yu10mx = 0.0     ; yu10my = 0.0    ; ywindsp = 0.0   
     536    yrugoro = 0.0 ; ywindsp = 0.0   
    537537    d_ts = 0.0    ; yfluxlat=0.0     ; flux_t = 0.0    ; flux_q = 0.0     
    538538    flux_u = 0.0  ; flux_v = 0.0     ; d_t = 0.0       ; d_q = 0.0     
    539     d_u = 0.0     ; d_v = 0.0        ; zcoefh = 0.0    ; yqsol = 0.0   
     539    d_u = 0.0     ; d_v = 0.0        ; yqsol = 0.0   
    540540    ytherm = 0.0  ; ytke=0.
    541      
     541   
     542    zcoefh(:,:) = 0.0
     543    zcoefh(:,1) = 999999. ! zcoefh(:,k=1) should never be used
    542544    ytsoil = 999999.
    543545
    … …  
    555557       ENDDO
    556558    ENDDO
    557     DO i = 1, klon
    558        zx_alf1 = 1.0
    559        zx_alf2 = 1.0 - zx_alf1
    560        u1lay(i) = u(i,1)*zx_alf1 + u(i,2)*zx_alf2
    561        v1lay(i) = v(i,1)*zx_alf1 + v(i,2)*zx_alf2
    562     ENDDO
    563 
    564559
    565560!****************************************************************************************
    … …  
    688683          yrugos(j)  = rugos(i,nsrf)
    689684          yrugoro(j) = rugoro(i)
    690           yu1(j)     = u1lay(i)
    691           yv1(j)     = v1lay(i)
     685          yu1(j)     = u(i,1)
     686          yv1(j)     = v(i,1)
    692687          ypaprs(j,klev+1) = paprs(i,klev+1)
    693           yu10mx(j) = u10m(i,nsrf)
    694           yu10my(j) = v10m(i,nsrf)
    695           ywindsp(j) = SQRT(yu10mx(j)*yu10mx(j) + yu10my(j)*yu10my(j) )
     688          ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 )
    696689       END DO
    697690
    … …  
    726719       
    727720!****************************************************************************************
    728 ! 6) Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the
    729 !    atmosphere and coefficients for turbulent diffusion at surface(Cdrag).
     721! 6a) Calculate coefficients for turbulent diffusion at surface, cdragh et cdragm.
     722!
     723!****************************************************************************************
     724
     725       CALL clcdrag( knon, nsrf, ypaprs, ypplay, &
     726            yu(:,1), yv(:,1), yt(:,1), yq(:,1), &
     727            yts, yqsurf, yrugos, &
     728            ycdragm, ycdragh )
     729
     730!****************************************************************************************
     731! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefm et ycoefm.
    730732!
    731733!****************************************************************************************
    732734
    733735       CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    734             ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, &
     736            ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, &
    735737            ycoefm, ycoefh, ytke)
    736738       
    … …  
    748750       CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, &
    749751            ydelp, yt, yq, dtime, &
    750             petAcoef, peqAcoef, petBcoef, peqBcoef)
     752            AcoefH, AcoefQ, BcoefH, BcoefQ)
    751753
    752754! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V
    753        CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv)
     755       CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, &
     756            AcoefU, AcoefV, BcoefU, BcoefV)
    754757     
    755758
    … …  
    783786               rlon, rlat, &
    784787               debut, lafin, ydelp(:,1), r_co2_ppm, ysolsw, ysollw, yalb, &
    785                yts, ypplay(:,1), ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    786                petAcoef, peqAcoef, petBcoef, peqBcoef, &
     788               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     789               AcoefH, AcoefQ, BcoefH, BcoefQ, &
     790               AcoefU, AcoefV, BcoefU, BcoefV, &
    787791               ypsref, yu1, yv1, yrugoro, pctsrf, &
    788792               ysnow, yqsol, yagesno, ytsoil, &
    789793               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    790794               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
     795               y_flux_u1, y_flux_v1, &
    791796               ylwdown)
    792797     
    … …  
    794799          CALL surf_landice(itap, dtime, knon, ni, &
    795800               ysolsw, ysollw, yts, ypplay(:,1), &
    796                ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    797                petAcoef, peqAcoef, petBcoef, peqBcoef, &
     801               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     802               AcoefH, AcoefQ, BcoefH, BcoefQ, &
     803               AcoefU, AcoefV, BcoefU, BcoefV, &
    798804               ypsref, yu1, yv1, yrugoro, pctsrf, &
    799805               ysnow, yqsurf, yqsol, yagesno, &
    800806               ytsoil, yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    801                ytsurf_new, y_dflux_t, y_dflux_q)
     807               ytsurf_new, y_dflux_t, y_dflux_q, &
     808               y_flux_u1, y_flux_v1)
    802809         
    803810       CASE(is_oce)
    … …  
    805812               yrugos, ywindsp, rmu0, yfder, yts, &
    806813               itap, dtime, jour, knon, ni, &
    807                debut, &
    808                ypplay(:,1), ycoefh(:,1), ycoefm(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    809                petAcoef, peqAcoef, petBcoef, peqBcoef, &
     814               ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     815               AcoefH, AcoefQ, BcoefH, BcoefQ, &
     816               AcoefU, AcoefV, BcoefU, BcoefV, &
    810817               ypsref, yu1, yv1, yrugoro, pctsrf, &
    811818               ysnow, yqsurf, yagesno, &
    812819               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    813                ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils)
     820               ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, &
     821               y_flux_u1, y_flux_v1)
    814822         
    815823       CASE(is_sic)
    … …  
    817825               rlon, rlat, ysolsw, ysollw, yalb1, yfder, &
    818826               itap, dtime, jour, knon, ni, &
    819                debut, lafin, &
    820                yts, ypplay(:,1), ycoefh(:,1), yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    821                petAcoef, peqAcoef, petBcoef, peqBcoef, &
     827               lafin, &
     828               yts, ypplay(:,1), ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
     829               AcoefH, AcoefQ, BcoefH, BcoefQ, &
     830               AcoefU, AcoefV, BcoefU, BcoefV, &
    822831               ypsref, yu1, yv1, yrugoro, pctsrf, &
    823832               ysnow, yqsurf, yqsol, yagesno, ytsoil, &
    824833               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    825                ytsurf_new, y_dflux_t, y_dflux_q)
     834               ytsurf_new, y_dflux_t, y_dflux_q, &
     835               y_flux_u1, y_flux_v1)
    826836         
    827837
    … …  
    848858!****************************************************************************************
    849859! H and Q
    850 !       print *,'pbl_surface: ok_flux_surf=',ok_flux_surf
    851 !       print *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
    852        if (ok_flux_surf) then
     860       IF (ok_flux_surf) THEN
     861          PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT
    853862          y_flux_t1(:) =  fsens
    854863          y_flux_q1(:) =  flat/RLVTT
    855864          yfluxlat(:) =  flat
    856        else
     865       ELSE
    857866          y_flux_t1(:) =  yfluxsens(:)
    858867          y_flux_q1(:) = -yevap(:)
    859        endif
     868       ENDIF
    860869
    861870       CALL climb_hq_up(knon, dtime, yt, yq, &
    … …  
    863872            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))   
    864873       
    865 ! U and V
    866        CALL climb_wind_up(knon, dtime, yu, yv, &
     874
     875       CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, &
    867876            y_flux_u, y_flux_v, y_d_u, y_d_v)
     877
    868878
    869879       DO j = 1, knon
    870880          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
    871881          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
    872           yu1(j) = yu1(j) *  ypct(j)
    873           yv1(j) = yv1(j) *  ypct(j)
    874882       ENDDO
    875883
    … …  
    886894          DO j = 1, knon
    887895             i = ni(j)
    888              ycoefh(j,k) = ycoefh(j,k) * ypct(j)
    889              ycoefm(j,k) = ycoefm(j,k) * ypct(j)
    890896             y_d_t(j,k)  = y_d_t(j,k) * ypct(j)
    891897             y_d_q(j,k)  = y_d_q(j,k) * ypct(j)
    … …  
    902908          ENDDO
    903909       ENDDO
    904        
     910
    905911       evap(:,nsrf) = - flux_q(:,1,nsrf)
    906912       
    … …  
    921927          fluxlat(i,nsrf) = yfluxlat(j)
    922928          agesno(i,nsrf) = yagesno(j) 
    923           cdragh(i) = cdragh(i) + ycoefh(j,1)
    924           cdragm(i) = cdragm(i) + ycoefm(j,1)
     929          cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
     930          cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
    925931          dflux_t(i) = dflux_t(i) + y_dflux_t(j)
    926932          dflux_q(i) = dflux_q(i) + y_dflux_q(j)
    927           zu1(i) = zu1(i) + yu1(j)
    928           zv1(i) = zv1(i) + yv1(j)
     933       END DO
     934
     935       DO k = 2, klev
     936          DO j = 1, knon
     937             i = ni(j)
     938             zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)*ypct(j)
     939          END DO
    929940       END DO
    930941
    … …  
    945956       
    946957       
    947 #ifdef CRAY
    948958       DO k = 1, klev
    949959          DO j = 1, knon
    950960             i = ni(j)
    951 #else
    952        DO j = 1, knon
    953           i = ni(j)
    954           DO k = 1, klev
    955 #endif
    956961             d_t(i,k) = d_t(i,k) + y_d_t(j,k)
    957962             d_q(i,k) = d_q(i,k) + y_d_q(j,k)
    958963             d_u(i,k) = d_u(i,k) + y_d_u(j,k)
    959964             d_v(i,k) = d_v(i,k) + y_d_v(j,k)
    960              zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k)
    961 #ifdef CRAY
    962965          END DO
    963966       END DO
    964 #else
    965           END DO
    966        END DO
    967 #endif
    968967
    969968!****************************************************************************************
    … …  
    11521151       PRINT*,' debut apres d_ts min max ftsol(ts)',itap,amn,amx
    11531152    ENDIF
     1153
     1154!jg ?
    11541155!!$!
    11551156!!$! If a sub-surface does not exsist for a grid point, the mean value for all
    … …  
    11941195    END DO
    11951196
     1197! Premier niveau de vent sortie dans physiq.F
     1198    zu1(:) = u(:,1)
     1199    zv1(:) = v(:,1)
    11961200
    11971201! Some of the module declared variables are returned for printing in physiq.F
    … …  
    12731277    CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
    12741278    INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
    1275     LOGICAL           :: debug=.FALSE.
    12761279!
    12771280! All at once !!
    … …  
    13021305       DO i=1, klon
    13031306          IF (pctsrf_new(i,nsrf) > 0. .AND. pctsrf_old(i,nsrf) == 0.) THEN
    1304 
     1307             
    13051308             IF (pctsrf_old(i,nsrf_comp1) > 0.) THEN
    13061309                ! Use the complement sub-surface, keeping the continents unchanged
    … …  
    13421345    END DO
    13431346
    1344     IF (debug) THEN
    1345        print*,'itime=,',itime, 'Pas de nouveau fraction',pfois,'fois'
    1346        print*,'itime=,',itime, 'The fraction of the continents have changed',nfois,'fois'
    1347        print*,'itime=,',itime, 'The fraction ocean-seaice has changed',mfois,'fois'
    1348     END IF
    1349 
    13501347  END SUBROUTINE pbl_surface_newfrac
    13511348

  • LMDZ4/trunk/libf/phylmd/phys_output_write.h

    r1063 r1067  
    916916
    917917       IF (flag_kz(iff)<=lev_files(iff)) THEN
    918       CALL histwrite_phy(nid_files(iff),"kz",itau_w,ycoefh)
     918      ! combinaision de cdrag et le coef melange dans la meme variable
     919      zx_tmp_fi3d(:,1)     = cdragh(:)
     920      zx_tmp_fi3d(:,2:klev)= coefh(:,2:klev)
     921      CALL histwrite_phy(nid_files(iff),"kz",itau_w,zx_tmp_fi3d)
    919922       ENDIF
    920923
    921924       IF (flag_kz_max(iff)<=lev_files(iff)) THEN
    922       CALL histwrite_phy(nid_files(iff),"kz_max",itau_w,ycoefh)
     925      ! combinaision de cdrag et le coef melange dans la meme variable
     926      zx_tmp_fi3d(:,1)     = cdragh(:)
     927      zx_tmp_fi3d(:,2:klev)= coefh(:,2:klev)
     928      CALL histwrite_phy(nid_files(iff),"kz_max",itau_w,zx_tmp_fi3d)
    923929       ENDIF
    924930

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r1065 r1067  
    4242c   =====================
    4343c#define histhf
    44 #define histday
    45 #define histmth
     44c#define histday
     45c#define histmth
    4646c#define histmthNMC
    4747c#define histins
    … …  
    679679cAA  Pour phytrac
    680680cAA
    681       REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
    682       REAL yu1(klon)            ! vents dans la premiere couche U
    683       REAL yv1(klon)            ! vents dans la premiere couche V
     681      REAL coefh(klon,klev)     ! coef d'echange pour phytrac, valable pour 2<=k<=klev
     682      REAL u1(klon)             ! vents dans la premiere couche U
     683      REAL v1(klon)             ! vents dans la premiere couche V
    684684
    685685      REAL zxffonte(klon), zxfqcalving(klon),zxfqfonte(klon)
    … …  
    18651865     e     pplay,     paprs,     pctsrf,           
    18661866     +     ftsol,     falb1,     falb2,   u10m,   v10m,
    1867      s     sollwdown, cdragh,    cdragm,  yu1,    yv1,
     1867     s     sollwdown, cdragh,    cdragm,  u1,    v1,
    18681868     s     albsol1,   albsol2,   sens,    evap, 
    18691869     s     zxtsol,    zxfluxlat, zt2m,    qsat2m,
    18701870     s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
    1871      s     ycoefh,    slab_wfbils,               
     1871     s     coefh,     slab_wfbils,               
    18721872     d     qsol,      zq2m,      s_pblh,  s_lcl,
    18731873     d     s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    … …  
    18811881     -     zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
    18821882
    1883      
     1883
    18841884!-----------------------------------------------------------------------------------------
    18851885! ajout des tendances de la diffusion turbulente
    … …  
    28442844     $                          paprs,
    28452845     $                          pplay,
    2846      $                          ycoefh,
     2846     $                          coefh,
    28472847     $                          pphi,
    28482848     $                          t_seri,
    … …  
    32083208     I                   pen_d,
    32093209     I                   pde_d,
    3210      I                   ycoefh,
     3210     I                   cdragh,
     3211     I                   coefh,
    32113212     I                   fm_therm,
    32123213     I                   entr_therm,
    3213      I                   yu1,
    3214      I                   yv1,
     3214     I                   u1,
     3215     I                   v1,
    32153216     I                   ftsol,
    32163217     I                   pctsrf,
    … …  
    32563257     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    32573258     I                   fm_therm,entr_therm,
    3258      I                   ycoefh,yu1,yv1,ftsol,pctsrf,
     3259     I                   cdragh,coefh,u1,v1,ftsol,pctsrf,
    32593260     I                   frac_impa, frac_nucl,
    32603261     I                   pphis,airephy,dtime,itap)

  • LMDZ4/trunk/libf/phylmd/phystokenc.F

    r776 r1067  
    1 !
    2 ! $Header$
    31!
    42c
    … …  
    86     I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    97     I                   pfm_therm,pentr_therm,
    10      I                   pcoefh,yu1,yv1,ftsol,pctsrf,
     8     I                   cdragh, pcoefh,yu1,yv1,ftsol,pctsrf,
    119     I                   frac_impa,frac_nucl,
    1210     I                   pphis,paire,dtime,itap)
    … …  
    6563c   --------------
    6664c
    67       REAL pcoefh(klon,klev)    ! coeff melange CL
     65      REAL cdragh(klon)          ! cdrag
     66      REAL pcoefh(klon,klev)     ! coeff melange CL
     67      REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
    6868      REAL yv1(klon)
    6969      REAL yu1(klon),pphis(klon),paire(klon)
    … …  
    126126c   Couche limite:
    127127c======================================================================
     128
     129c Dans le meme vecteur on recombine le drag et les coeff d'echange
     130      pcoefh_buf(:,1)      = cdragh(:)
     131      pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
    128132
    129133      ok_sync = .true.
    … …  
    214218            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
    215219            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
    216             coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
     220            coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
    217221                t(i,k)=t(i,k)+pt(i,k)*pdtphys
    218222       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
    … …  
    407411            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
    408412            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
    409             coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
     413            coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
    410414                t(i,k)=t(i,k)+pt(i,k)*pdtphys
    411415       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys

  • LMDZ4/trunk/libf/phylmd/phytrac.F

    r959 r1067  
    1 !
    2 ! $Header$
    31!
    42c
    … …  
    2523     I                    pen_d,
    2624     I                    pde_d,
     25     I                    cdragh,
    2726     I                    coefh,
    2827     I                    fm_therm,
    … …  
    175174c   --------------
    176175c
     176      REAL cdragh(nlon,nlev)! coeff drag pour T et Q
    177177      REAL coefh(nlon,nlev) ! coeff melange CL
    178178      REAL yu1(nlon)        ! vents au premier niveau
    … …  
    663663      if (clsol(it)) then  ! couche limite avec quantite dans le sol calculee
    664664          CALL cltracrn(it, pdtphys, yu1, yv1,
    665      e                    coefh,t_seri,ftsol,pctsrf,
     665     e                    cdragh, coefh,t_seri,ftsol,pctsrf,
    666666     e                    tr_seri(1,1,it),trs(1,it),
    667667     e                    paprs, pplay, delp,

  • LMDZ4/trunk/libf/phylmd/surf_land_bucket_mod.F90

    r996 r1067  
    11!
    2 ! $Header$
    3 !
    4 MODULE surf_land_bucket_mod
     2!MODULE surf_land_bucket_mod
    53!
    64! Surface land bucket module
    … …  
    1513       tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
    1614       spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
    17        u1_lay, v1_lay, rugoro, swnet, lwnet, &
     15       u1, v1, rugoro, swnet, lwnet, &
    1816       snow, qsol, agesno, tsoil, &
    1917       qsurf, z0_new, alb1_new, alb2_new, evap, &
    … …  
    5048    REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
    5149    REAL, DIMENSION(klon), INTENT(IN)       :: pref
    52     REAL, DIMENSION(klon), INTENT(IN)       :: u1_lay, v1_lay
     50    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1
    5351    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    5452    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
    … …  
    7674    REAL, DIMENSION(klon) :: zfra
    7775    REAL, DIMENSION(klon) :: radsol       ! total net radiance at surface
     76    REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
    7877    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
    7978    INTEGER               :: i
    … …  
    110109    ENDIF
    111110   
     111! Suppose zero surface speed
     112    u0(:)=0.0
     113    v0(:)=0.0
     114    u1_lay(:) = u1(:) - u0(:)
     115    v1_lay(:) = v1(:) - v0(:)
     116
    112117    CALL calcul_fluxs(knon, is_ter, dtime, &
    113118         tsurf, p1lay, cal, beta, tq_cdrag, pref, &

  • LMDZ4/trunk/libf/phylmd/surf_land_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE surf_land_mod
    53 
    6   USE surface_data, ONLY    : ok_veget
    7   USE dimphy
    8  
    9 #ifdef CPP_VEGET
    10   USE surf_land_orchidee_mod
    11 #endif
    12   USE surf_land_bucket_mod
    13 
    144  IMPLICIT NONE
    155
    … …  
    2111       rlon, rlat, &
    2212       debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
    23        tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    24        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    25        pref, u1_lay, v1_lay, rugoro, pctsrf, &
     13       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     15       AcoefU, AcoefV, BcoefU, BcoefV, &
     16       pref, u1, v1, rugoro, pctsrf, &
    2617       snow, qsol, agesno, tsoil, &
    2718       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    2819       qsurf, tsurf_new, dflux_s, dflux_l, &
     20       flux_u1, flux_v1, &
    2921       lwdown_m)
     22
     23    USE dimphy
     24    USE surface_data, ONLY    : ok_veget
     25    USE surf_land_orchidee_mod
     26    USE surf_land_bucket_mod
     27    USE calcul_fluxs_mod
    3028
    3129    INCLUDE "indicesol.h"
    … …  
    4644    REAL, DIMENSION(klon), INTENT(IN)       :: tsurf
    4745    REAL, DIMENSION(klon), INTENT(IN)       :: p1lay
    48     REAL, DIMENSION(klon), INTENT(IN)       :: tq_cdrag
     46    REAL, DIMENSION(klon), INTENT(IN)       :: cdragh, cdragm
    4947    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
    5048    REAL, DIMENSION(klon), INTENT(IN)       :: temp_air, spechum
    51     REAL, DIMENSION(klon), INTENT(IN)       :: petAcoef, peqAcoef
    52     REAL, DIMENSION(klon), INTENT(IN)       :: petBcoef, peqBcoef
     49    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefH, AcoefQ, BcoefH, BcoefQ
     50    REAL, DIMENSION(klon), INTENT(IN)       :: AcoefU, AcoefV, BcoefU, BcoefV
    5351    REAL, DIMENSION(klon), INTENT(IN)       :: pref   ! pressure reference
    54     REAL, DIMENSION(klon), INTENT(IN)       :: u1_lay, v1_lay
     52    REAL, DIMENSION(klon), INTENT(IN)       :: u1, v1
    5553    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    5654    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    … …  
    7573    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    7674    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
     75    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1  ! flux for U and V at first model level
    7776
    7877! Local variables
    … …  
    8483    REAL, DIMENSION(klon) :: epot_air           ! potential air temperature
    8584    REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
     85    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
    8686    INTEGER               :: i
    8787
    … …  
    117117       END DO
    118118
    119 #ifdef CPP_VEGET
    120119       ! temporary for keeping same results using lwdown_m instead of lwdown
    121120       CALL surf_land_orchidee(itime, dtime, date0, knon, &
    122121            knindex, rlon, rlat, pctsrf, &
    123122            debut, lafin, &
    124             zlev,  u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
    125             tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
     123            zlev,  u1, v1, temp_air, spechum, epot_air, ccanopy, &
     124            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
    126125            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
    127126            pref_tmp, &
    … …  
    129128            tsol_rad, tsurf_new, alb1_new, alb2_new, &
    130129            emis_new, z0_new, qsurf)       
    131 #endif
    132130
    133131! 
    … …  
    144142!****************************************************************************************
    145143       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
    146             tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
    147             spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
    148             u1_lay, v1_lay, rugoro, swnet, lwnet, &
     144            tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, &
     145            spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
     146            u1, v1, rugoro, swnet, lwnet, &
    149147            snow, qsol, agesno, tsoil, &
    150148            qsurf, z0_new, alb1_new, alb2_new, evap, &
    … …  
    153151    ENDIF ! ok_veget
    154152
     153!****************************************************************************************
     154! Calculation for all land models
     155! - Flux calculation at first modele level for U and V
     156!****************************************************************************************
     157! Suppose zero surface speed
     158    u0(:)=0.0
     159    v0(:)=0.0
     160    CALL calcul_flux_wind(knon, dtime, &
     161         u0, v0, u1, v1, cdragm, &
     162         AcoefU, AcoefV, BcoefU, BcoefV, &
     163         p1lay, temp_air, &
     164         flux_u1, flux_v1)
     165   
    155166  END SUBROUTINE surf_land
    156167!

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r1023 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE surf_land_orchidee_mod
    … …  
    108!                              Get_orchidee_communicator
    119!                              Init_neighbours
     10
     11  USE dimphy
    1212#ifdef CPP_VEGET
    13 
    14   USE dimphy
    1513  USE intersurf     ! module d'ORCHIDEE
     14#endif
    1615  USE cpl_mod,      ONLY : cpl_send_land_fields
    1716  USE surface_data, ONLY : type_ocean
    … …  
    203202 
    204203    IF (debut) THEN
     204! Test of coherence between variable ok_veget and cpp key CPP_VEGET
     205#ifndef CPP_VEGET
     206       abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
     207       CALL abort_gcm(modname,abort_message,1)
     208#endif
     209
    205210       CALL Init_surf_para(knon)
    206211       ALLOCATE(ktindex(knon))
    … …  
    368373       
    369374       IF (knon > 0) THEN
     375#ifdef CPP_VEGET
    370376         CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
     377#endif
    371378       ENDIF
    372379
    … …  
    374381       IF (knon > 0) THEN
    375382
     383#ifdef CPP_VEGET
    376384          CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
    377385               lrestart_read, lrestart_write, lalo, &
    … …  
    383391               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
    384392               lon_scat, lat_scat)
    385          
     393#endif         
    386394       ENDIF
    387395
    … …  
    397405
    398406    IF (knon > 0) THEN
    399    
     407#ifdef CPP_VEGET   
    400408       CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime,  &
    401409            lrestart_read, lrestart_write, lalo, &
    … …  
    407415            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
    408416            lon_scat, lat_scat)
    409        
     417#endif       
    410418    ENDIF
    411419
    … …  
    625633!
    626634
    627 #endif
    628 
    629635END MODULE surf_land_orchidee_mod

  • LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE surf_landice_mod
    53 
    6   USE dimphy
    7   USE surface_data,     ONLY : type_ocean, calice, calsno
    8   USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
    9   USE cpl_mod,          ONLY : cpl_send_landice_fields
    10   USE calcul_fluxs_mod, ONLY : calcul_fluxs
    11 
    124  IMPLICIT NONE
    135
    … …  
    1810  SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
    1911       swnet, lwnet, tsurf, p1lay, &
    20        tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    21        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    22        ps, u1_lay, v1_lay, rugoro, pctsrf, &
     12       cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     13       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     14       AcoefU, AcoefV, BcoefU, BcoefV, &
     15       ps, u1, v1, rugoro, pctsrf, &
    2316       snow, qsurf, qsol, agesno, &
    2417       tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
    25        tsurf_new, dflux_s, dflux_l)
     18       tsurf_new, dflux_s, dflux_l, &
     19       flux_u1, flux_v1)
     20
     21    USE dimphy
     22    USE surface_data,     ONLY : type_ocean, calice, calsno
     23    USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
     24    USE cpl_mod,          ONLY : cpl_send_landice_fields
     25    USE calcul_fluxs_mod
    2626
    2727    INCLUDE "indicesol.h"
    … …  
    3939    REAL, DIMENSION(klon), INTENT(IN)             :: tsurf
    4040    REAL, DIMENSION(klon), INTENT(IN)             :: p1lay
    41     REAL, DIMENSION(klon), INTENT(IN)             :: tq_cdrag
     41    REAL, DIMENSION(klon), INTENT(IN)             :: cdragh, cdragm
    4242    REAL, DIMENSION(klon), INTENT(IN)             :: precip_rain, precip_snow
    4343    REAL, DIMENSION(klon), INTENT(IN)             :: temp_air, spechum
    44     REAL, DIMENSION(klon), INTENT(IN)             :: petAcoef, peqAcoef
    45     REAL, DIMENSION(klon), INTENT(IN)             :: petBcoef, peqBcoef
     44    REAL, DIMENSION(klon), INTENT(IN)             :: AcoefH, AcoefQ
     45    REAL, DIMENSION(klon), INTENT(IN)             :: BcoefH, BcoefQ
     46    REAL, DIMENSION(klon), INTENT(IN)             :: AcoefU, AcoefV, BcoefU, BcoefV
    4647    REAL, DIMENSION(klon), INTENT(IN)             :: ps
    47     REAL, DIMENSION(klon), INTENT(IN)             :: u1_lay, v1_lay
     48    REAL, DIMENSION(klon), INTENT(IN)             :: u1, v1
    4849    REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
    4950    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
    … …  
    6465    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
    6566    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
     67    REAL, DIMENSION(klon), INTENT(OUT)            :: flux_u1, flux_v1
    6668
    6769! Local variables
    … …  
    7173    REAL, DIMENSION(klon)    :: zfra, alb_neig
    7274    REAL, DIMENSION(klon)    :: radsol
     75    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay
    7376
    7477! End definition
    … …  
    107110    dif_grnd(:) = 0.0
    108111
     112! Suppose zero surface speed
     113    u0(:)=0.0
     114    v0(:)=0.0
     115    u1_lay(:) = u1(:) - u0(:)
     116    v1_lay(:) = v1(:) - v0(:)
     117
    109118    CALL calcul_fluxs(knon, is_lic, dtime, &
    110          tsurf, p1lay, cal, beta, tq_cdrag, ps, &
     119         tsurf, p1lay, cal, beta, cdragh, ps, &
    111120         precip_rain, precip_snow, snow, qsurf,  &
    112121         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    113          petAcoef, peqAcoef, petBcoef, peqBcoef, &
     122         AcoefH, AcoefQ, BcoefH, BcoefQ, &
    114123         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    115124
     125    CALL calcul_flux_wind(knon, dtime, &
     126         u0, v0, u1, v1, cdragm, &
     127         AcoefU, AcoefV, BcoefU, BcoefV, &
     128         p1lay, temp_air, &
     129         flux_u1, flux_v1)
    116130
    117131!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE surf_ocean_mod
    5 
    6   USE dimphy
    7   USE surface_data, ONLY     : type_ocean
    8   USE ocean_forced_mod, ONLY : ocean_forced_noice
    9   USE ocean_slab_mod, ONLY   : ocean_slab_noice
    10   USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
    113
    124  IMPLICIT NONE
    … …  
    1911       rugos, windsp, rmu0, fder, tsurf_in, &
    2012       itime, dtime, jour, knon, knindex, &
    21        debut, &
    22        p1lay, tq_cdrag, coefm, precip_rain, precip_snow, temp_air, spechum, &
    23        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    24        ps, u1_lay, v1_lay, rugoro, pctsrf, &
     13       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     15       AcoefU, AcoefV, BcoefU, BcoefV, &
     16       ps, u1, v1, rugoro, pctsrf, &
    2517       snow, qsurf, agesno, &
    2618       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    27        tsurf_new, dflux_s, dflux_l, lmt_bils)
     19       tsurf_new, dflux_s, dflux_l, lmt_bils, &
     20       flux_u1, flux_v1)
     21
     22  USE dimphy
     23  USE surface_data, ONLY     : type_ocean
     24  USE ocean_forced_mod, ONLY : ocean_forced_noice
     25  USE ocean_slab_mod, ONLY   : ocean_slab_noice
     26  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
    2827!
    2928! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
    … …  
    4948    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
    5049    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    51     REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
    52     REAL, DIMENSION(klon), INTENT(IN)        :: coefm
     50    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
     51    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
    5352    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    5453    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    55     REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
    56     REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
     54    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
     55    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    5756    REAL, DIMENSION(klon), INTENT(IN)        :: ps
    58     REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
     57    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
    5958    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
    6059    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    61     LOGICAL, INTENT(IN)                      :: debut
    6260
    6361! In/Output variables
    … …  
    7674    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    7775    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
     76    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    7877
    7978! Local variables
    … …  
    101100       CALL ocean_cpl_noice( &
    102101            swnet, lwnet, alb1, &
    103             windsp, &
    104             fder, &
     102            windsp, fder, &
    105103            itime, dtime, knon, knindex, &
    106             p1lay, tq_cdrag, precip_rain, precip_snow,temp_air,spechum,&
    107             petAcoef, peqAcoef, petBcoef, peqBcoef, &
    108             ps, u1_lay, v1_lay, &
     104            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
     105            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     106            AcoefU, AcoefV, BcoefU, BcoefV, &
     107            ps, u1, v1, &
    109108            radsol, snow, agesno, &
    110             qsurf, evap, fluxsens, fluxlat, &
     109            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    111110            tsurf_new, dflux_s, dflux_l)
    112111
    … …  
    114113       CALL ocean_slab_noice( &
    115114            itime, dtime, jour, knon, knindex, &
    116             p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
    117             petAcoef, peqAcoef, petBcoef, peqBcoef, &
    118             ps, u1_lay, v1_lay, tsurf_in, &
     115            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
     116            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     117            AcoefU, AcoefV, BcoefU, BcoefV, &
     118            ps, u1, v1, tsurf_in, &
    119119            radsol, snow, agesno, &
    120             qsurf, evap, fluxsens, fluxlat, &
     120            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    121121            tsurf_new, dflux_s, dflux_l, lmt_bils)
    122122       
    … …  
    124124       CALL ocean_forced_noice( &
    125125            itime, dtime, jour, knon, knindex, &
    126             debut, &
    127             p1lay, tq_cdrag, precip_rain, precip_snow, &
     126            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
    128127            temp_air, spechum, &
    129             petAcoef, peqAcoef, petBcoef, peqBcoef, &
    130             ps, u1_lay, v1_lay, &
     128            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     129            AcoefU, AcoefV, BcoefU, BcoefV, &
     130            ps, u1, v1, &
    131131            radsol, snow, agesno, &
    132             qsurf, evap, fluxsens, fluxlat, &
     132            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    133133            tsurf_new, dflux_s, dflux_l)
    134134    END SELECT
    … …  
    158158    z0_new(:) = 0.0
    159159    DO i = 1, knon
    160        z0_new(i) = 0.018*coefm(i) * (u1_lay(i)**2+v1_lay(i)**2)/RG  &
    161             +  0.11*14e-6 / SQRT(coefm(i) * (u1_lay(i)**2+v1_lay(i)**2))
     160       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
     161            +  0.11*14e-6 / SQRT(cdragm(i) * (u1(i)**2+v1(i)**2))
    162162       z0_new(i) = MAX(1.5e-05,z0_new(i))
    163163    ENDDO

  • LMDZ4/trunk/libf/phylmd/surf_seaice_mod.F90

    r996 r1067  
    1 !
    2 ! $Header$
    31!
    42MODULE surf_seaice_mod
    53
    6   USE dimphy
    7   USE surface_data
    8   USE ocean_forced_mod, ONLY : ocean_forced_ice
    9   USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
    104  IMPLICIT NONE
    115
    … …  
    1711       rlon, rlat, swnet, lwnet, alb1, fder, &
    1812       itime, dtime, jour, knon, knindex, &
    19        debut, lafin, &
    20        tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
    21        petAcoef, peqAcoef, petBcoef, peqBcoef, &
    22        ps, u1_lay, v1_lay, rugoro, pctsrf, &
     13       lafin, &
     14       tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     15       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     16       AcoefU, AcoefV, BcoefU, BcoefV, &
     17       ps, u1, v1, rugoro, pctsrf, &
    2318       snow, qsurf, qsol, agesno, tsoil, &
    2419       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    25        tsurf_new, dflux_s, dflux_l)
     20       tsurf_new, dflux_s, dflux_l, &
     21       flux_u1, flux_v1)
     22
     23  USE dimphy
     24  USE surface_data
     25  USE ocean_forced_mod, ONLY : ocean_forced_ice
     26  USE ocean_cpl_mod, ONLY    : ocean_cpl_ice
     27
    2628!
    2729! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
    … …  
    3638    INTEGER, INTENT(IN)                      :: itime, jour, knon
    3739    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
    38     LOGICAL, INTENT(IN)                      :: debut, lafin
     40    LOGICAL, INTENT(IN)                      :: lafin
    3941    REAL, INTENT(IN)                         :: dtime
    4042    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
    … …  
    4850    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    4951    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    50     REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
    51     REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
     52    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
     53    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    5254    REAL, DIMENSION(klon), INTENT(IN)        :: ps
    53     REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
     55    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
    5456    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
    5557    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    … …  
    6971    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    7072    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
     73    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    7174
    7275! Local arguments
    7376!****************************************************************************************
    7477    REAL, DIMENSION(klon)  :: radsol
     78
    7579!
    7680! End definitions
    … …  
    96100            itime, dtime, knon, knindex, &
    97101            lafin,&
    98             p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
    99             petAcoef, peqAcoef, petBcoef, peqBcoef, &
    100             ps, u1_lay, v1_lay, pctsrf, &
     102            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
     103            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     104            AcoefU, AcoefV, BcoefU, BcoefV, &
     105            ps, u1, v1, pctsrf, &
    101106            radsol, snow, qsurf, &
    102             alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     107            alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    103108            tsurf_new, dflux_s, dflux_l)
    104109       
    105110    ELSE IF (type_ocean == 'force' .OR. (type_ocean == 'slab' .AND. version_ocean=='sicOBS')) THEN
    106        CALL ocean_forced_ice(itime, dtime, jour, knon, knindex, &
    107             debut, &
    108             tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
    109             petAcoef, peqAcoef, petBcoef, peqBcoef, &
    110             ps, u1_lay, v1_lay, &
     111       CALL ocean_forced_ice( &
     112            itime, dtime, jour, knon, knindex, &
     113            tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
     114            AcoefH, AcoefQ, BcoefH, BcoefQ, &
     115            AcoefU, AcoefV, BcoefU, BcoefV, &
     116            ps, u1, v1, &
    111117            radsol, snow, qsol, agesno, tsoil, &
    112             qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     118            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    113119            tsurf_new, dflux_s, dflux_l)
    114120
    … …  
    117123!!$          itime, dtime, jour, knon, knindex, &
    118124!!$          debut, &
    119 !!$          tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum,&
    120 !!$          petAcoef, peqAcoef, petBcoef, peqBcoef, &
    121 !!$          ps, u1_lay, v1_lay, pctsrf, &
     125!!$          tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, spechum,&
     126!!$          AcoefH, AcoefQ, BcoefH, BcoefQ, &
     127!!$          ps, u1, v1, pctsrf, &
    122128!!$          radsol, snow, qsurf, qsol, agesno, tsoil, &
    123129!!$          alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    … …  
    133139    z0_new = SQRT(z0_new**2+rugoro**2)
    134140
    135 
    136141  END SUBROUTINE surf_seaice
    137142!
Note: See TracChangeset for help on using the changeset viewer.