Ignore:
Timestamp:
Jun 25, 2014, 5:43:19 PM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2054:2070 into testing branch

Location:
LMDZ5/branches/testing
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/conf_phys_m.F90

    r2056 r2073  
    5353    ! type_ocean:      type d'ocean (force, slab, couple)
    5454    ! version_ocean:   version d'ocean (opa8/nemo pour type_ocean=couple ou
    55     !                                   sicOBS pour type_ocean=slab)
     55    !                                   sicOBS,sicINT,sicNO pour type_ocean=slab)
    5656    ! ok_veget:   type de modele de vegetation
    5757    ! ok_journe:  sorties journalieres
    … …  
    19331933    IF (type_ocean=='slab' .AND. version_ocean=='xxxxxx') THEN
    19341934       version_ocean='sicOBS'
    1935     ELSE IF (type_ocean=='slab' .AND. version_ocean/='sicOBS') THEN
     1935    ELSE IF (type_ocean=='slab' .AND. version_ocean/='sicOBS' &
     1936             .AND. version_ocean/='sicINT' .AND. version_ocean/='sicNO') THEN
    19361937       WRITE(lunout,*)' ERROR version_ocean=',version_ocean,' not valid with slab ocean'
    19371938       CALL abort_gcm('conf_phys','version_ocean not valid',1)

  • LMDZ5/branches/testing/libf/phylmd/dimphy.F90

    r1910 r2073  
    99  INTEGER,SAVE :: klevm1
    1010  INTEGER,SAVE :: kflev
     11  INTEGER,SAVE :: nslay
    1112
    12 !$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
     13!$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon,nslay)
    1314  REAL,save,allocatable,dimension(:) :: zmasq
    1415!$OMP THREADPRIVATE(zmasq)   
    … …  
    2324   
    2425    klon=klon0
    25    
     26    nslay=1 ! Slab, provisoire (F. Codron)
    2627    kdlon=klon
    2728    kidia=1

  • LMDZ5/branches/testing/libf/phylmd/limit_slab.F90

    r1910 r2073  
    11! $Header$
    22
    3 SUBROUTINE limit_slab(itime, dtime, jour, lmt_bils, lmt_foce, diff_sst)
     3SUBROUTINE limit_slab(itime, dtime, jour, lmt_bils, diff_sst)
    44
    55  USE dimphy
    … …  
    2020  INTEGER, INTENT(IN) :: jour    ! jour a lire dans l'annee
    2121  REAL   , INTENT(IN) :: dtime   ! pas de temps de la physique (en s)
    22   REAL, DIMENSION(klon), INTENT(OUT) :: lmt_bils, lmt_foce, diff_sst
     22  REAL, DIMENSION(klon), INTENT(OUT) :: lmt_bils, diff_sst
    2323
    2424! Locals variables with attribute SAVE
    2525!****************************************************************************************
    26   REAL, DIMENSION(:), ALLOCATABLE, SAVE :: bils_save, foce_save
    27 !$OMP THREADPRIVATE(bils_save, foce_save)
     26  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: bils_save, diff_sst_save
     27!$OMP THREADPRIVATE(bils_save, diff_sst_save)
    2828
    2929! Locals variables
    … …  
    3232  INTEGER                  :: nvarid, nid, ierr, i
    3333  INTEGER, DIMENSION(2)    :: start, epais
    34   REAL, DIMENSION(klon_glo):: bils_glo, foce_glo, sst_l_glo, sst_lp1_glo, diff_sst_glo
     34  REAL, DIMENSION(klon_glo):: bils_glo, sst_l_glo, sst_lp1_glo, diff_sst_glo
    3535  CHARACTER (len = 20)     :: modname = 'limit_slab'
     36  LOGICAL                  :: read_bils,read_sst
    3637
    3738! End declaration
    … …  
    4142  lmt_pas = NINT(86400./dtime)
    4243 
     44  ! F. Codron 5/14: add defaults for bils, diff_sst (0)
    4345  IF (MOD(itime-1, lmt_pas) == 0) THEN   ! time to read
    4446     !$OMP MASTER  ! Only master thread
    4547     IF (is_mpi_root) THEN ! Only master processus
    4648        print*,'in limit_slab time to read, itime=',itime
     49        read_bils=.TRUE.
     50        read_sst=.TRUE.
    4751       
    4852        ierr = NF90_OPEN ('limit_slab.nc', NF90_NOWRITE, nid)
    49         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,&
    50              'Pb in opening file limit_slab.nc',1)
     53        IF (ierr /= NF90_NOERR) THEN
     54            read_bils=.FALSE.
     55            read_sst=.FALSE.
     56        ELSE ! read file
    5157       
    5258        ! La tranche de donnees a lire:
    … …  
    5763
    5864!****************************************************************************************
    59 ! 2) Read bils and ocean fraction
     65! 2) Read bils and SST tendency
    6066!
    6167!****************************************************************************************
    … …  
    6369! Read bils_glo
    6470        ierr = NF90_INQ_VARID(nid, 'BILS_OCE', nvarid)
    65         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'The variable <BILS_OCE> is abstent',1)
    66 
    67         ierr = NF90_GET_VAR(nid,nvarid,bils_glo,start,epais)
    68         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Reading of <BILS_OCE> failed',1)
    69 !
    70 ! Read foce_glo
    71         ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)
    72         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'The variable <FOCE> is abstent',1)
    73 
    74         ierr = NF90_GET_VAR(nid,nvarid,foce_glo,start,epais)
    75         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Reading of <FOCE> failed',1)
    76 !
     71        IF (ierr /= NF90_NOERR) THEN
     72            read_bils=.FALSE.
     73        ELSE
     74            ierr = NF90_GET_VAR(nid,nvarid,bils_glo,start,epais)
     75            IF (ierr /= NF90_NOERR) read_bils=.FALSE.
     76        END IF
    7777! Read sst_glo for this day
    7878        ierr = NF90_INQ_VARID(nid, 'SST', nvarid)
    79         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'The variable <SST> is abstent',1)
    80 
    81         ierr = NF90_GET_VAR(nid,nvarid,sst_l_glo,start,epais)
    82         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Reading of <SST> failed',1)
    83 
     79        IF (ierr /= NF90_NOERR)  THEN
     80            read_sst=.FALSE.
     81        ELSE
     82            ierr = NF90_GET_VAR(nid,nvarid,sst_l_glo,start,epais)
     83            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
    8484! Read sst_glo for one day ahead
    85         start(2) = jour + 1
    86         IF (start(2) > 360) start(2)=1
    87         ierr = NF90_GET_VAR(nid,nvarid,sst_lp1_glo,start,epais)
    88         IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Reading of <SST> day+1 failed',1)
    89 
    90 ! Calculate difference in temperature between this day and one ahead
    91         DO i=1, klon_glo-1
    92            diff_sst_glo(i) = sst_lp1_glo(i) - sst_l_glo(i)
    93         END DO
    94         diff_sst_glo(klon_glo) = sst_lp1_glo(klon_glo) - sst_l_glo(1)
     85            start(2) = jour + 1
     86            IF (start(2) > 360) start(2)=1
     87            ierr = NF90_GET_VAR(nid,nvarid,sst_lp1_glo,start,epais)
     88            IF (ierr /= NF90_NOERR) read_sst=.FALSE.
     89        END IF
    9590
    9691!****************************************************************************************
    97 ! 5) Close file and distribuate variables to all processus
     92! 5) Close file and distribute variables to all processus
    9893!
    9994!****************************************************************************************
    10095        ierr = NF90_CLOSE(nid)
    10196        IF (ierr /= NF90_NOERR) CALL abort_gcm(modname,'Pb when closing file', 1)
     97        END IF ! Read File
     98        IF (read_sst) THEN
     99! Calculate difference in temperature between this day and one ahead
     100!            DO i=1, klon_glo-1
     101!               diff_sst_glo(i) = sst_lp1_glo(i) - sst_l_glo(i)
     102!            END DO
     103!            diff_sst_glo(klon_glo) = sst_lp1_glo(klon_glo) - sst_l_glo(1)
     104            DO i=1, klon_glo
     105               diff_sst_glo(i) = sst_lp1_glo(i) - sst_l_glo(i)
     106            END DO
     107        END IF !read_sst
    102108     ENDIF ! is_mpi_root
    103109
    … …  
    105111       
    106112     IF (.NOT. ALLOCATED(bils_save)) THEN
    107         ALLOCATE(bils_save(klon), foce_save(klon), stat=ierr)
     113        ALLOCATE(bils_save(klon), diff_sst_save(klon), stat=ierr)
    108114        IF (ierr /= 0) CALL abort_gcm('limit_slab', 'pb in allocation',1)
    109115     END IF
    110116
    111      CALL Scatter(bils_glo, bils_save)
    112      CALL Scatter(foce_glo, foce_save)
    113      CALL Scatter(diff_sst_glo, diff_sst)
     117! Giveddefault values if needed
     118     IF (read_bils) THEN
     119         CALL Scatter(bils_glo, bils_save)
     120     ELSE
     121         bils_save(:)=0.
     122     END IF
     123     IF (read_sst) THEN
     124         CALL Scatter(diff_sst_glo, diff_sst_save)
     125     ELSE
     126         diff_sst_save(:)=0.
     127     END IF
    114128     
    115   ELSE ! not time to read
    116      diff_sst(:) = 0.
    117129  ENDIF ! time to read
    118130
    119131  lmt_bils(:) = bils_save(:)
    120   lmt_foce(:) = foce_save(:)
     132  diff_sst(:) = diff_sst_save(:)
    121133 
    122134END SUBROUTINE limit_slab

  • LMDZ5/branches/testing/libf/phylmd/ocean_slab_mod.F90

    r1910 r2073  
    55! "ocean=slab".
    66!
     7
     8  USE dimphy
     9  USE indice_sol_mod
     10
    711  IMPLICIT NONE
    812  PRIVATE
    9   PUBLIC :: ocean_slab_frac, ocean_slab_noice
     13  PUBLIC :: ocean_slab_init, ocean_slab_frac, ocean_slab_noice!, ocean_slab_ice
     14
     15  INTEGER, PRIVATE, SAVE                           :: cpl_pas
     16  !$OMP THREADPRIVATE(cpl_pas)
     17  REAL, PRIVATE, SAVE                              :: cyang
     18  !$OMP THREADPRIVATE(cyang)
     19  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE   :: slabh
     20  !$OMP THREADPRIVATE(slabh)
     21  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: tslab
     22  !$OMP THREADPRIVATE(tslab)
     23  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE  :: pctsrf
     24  !$OMP THREADPRIVATE(pctsrf)
     25  REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE  :: slab_bils
     26  !$OMP THREADPRIVATE(slab_bils)
     27  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE  :: bils_cum
     28  !$OMP THREADPRIVATE(bils_cum)
    1029
    1130CONTAINS
    … …  
    1332!****************************************************************************************
    1433!
    15   SUBROUTINE ocean_slab_frac(itime, dtime, jour, pctsrf, is_modified)
    16 
    17     USE dimphy
     34  SUBROUTINE ocean_slab_init(dtime, pctsrf_rst)
     35  !, seaice_rst etc
     36
     37    use IOIPSL
     38
     39    INCLUDE "iniprint.h"
     40    ! For ok_xxx vars (Ekman...)
     41    INCLUDE "clesphys.h"
     42
     43    ! Input variables
     44!****************************************************************************************
     45    REAL, INTENT(IN)                         :: dtime
     46! Variables read from restart file
     47    REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf_rst
     48
     49! Local variables
     50!****************************************************************************************
     51    INTEGER                :: error
     52    CHARACTER (len = 80)   :: abort_message
     53    CHARACTER (len = 20)   :: modname = 'ocean_slab_intit'
     54
     55!****************************************************************************************
     56! Allocate surface fraction read from restart file
     57!****************************************************************************************
     58    ALLOCATE(pctsrf(klon,nbsrf), stat = error)
     59    IF (error /= 0) THEN
     60       abort_message='Pb allocation tmp_pctsrf_slab'
     61       CALL abort_gcm(modname,abort_message,1)
     62    ENDIF
     63    pctsrf(:,:) = pctsrf_rst(:,:)
     64
     65!****************************************************************************************
     66! Allocate local variables
     67!****************************************************************************************
     68    ALLOCATE(slab_bils(klon), stat = error)
     69    IF (error /= 0) THEN
     70       abort_message='Pb allocation slab_bils'
     71       CALL abort_gcm(modname,abort_message,1)
     72    ENDIF
     73    slab_bils(:) = 0.0   
     74    ALLOCATE(bils_cum(klon), stat = error)
     75    IF (error /= 0) THEN
     76       abort_message='Pb allocation slab_bils_cum'
     77       CALL abort_gcm(modname,abort_message,1)
     78    ENDIF
     79    bils_cum(:) = 0.0   
     80
     81! Layer thickness
     82    ALLOCATE(slabh(nslay), stat = error)
     83    IF (error /= 0) THEN
     84       abort_message='Pb allocation slabh'
     85       CALL abort_gcm(modname,abort_message,1)
     86    ENDIF
     87    slabh(1)=50.
     88! cyang = 1/heat capacity of top layer (rho.c.H)
     89    cyang=1/(slabh(1)*4.228e+06)
     90
     91! cpl_pas periode de couplage avec slab (update tslab, pctsrf)
     92! pour un calcul à chaque pas de temps, cpl_pas=1
     93    cpl_pas = NINT(86400./dtime * 1.0) ! une fois par jour
     94    CALL getin('cpl_pas',cpl_pas)
     95    print *,'cpl_pas',cpl_pas
     96 END SUBROUTINE ocean_slab_init
     97!
     98!****************************************************************************************
     99!
     100  SUBROUTINE ocean_slab_frac(itime, dtime, jour, pctsrf_chg, is_modified)
     101
    18102    USE limit_read_mod
    19103    USE surface_data
    20     USE indice_sol_mod
    21104
    22105!    INCLUDE "clesphys.h"
    … …  
    27110    INTEGER, INTENT(IN)                        :: jour    ! jour a lire dans l'annee
    28111    REAL   , INTENT(IN)                        :: dtime   ! pas de temps de la physique (en s)
    29     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf  ! sub-surface fraction
     112    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf_chg  ! sub-surface fraction
    30113    LOGICAL, INTENT(OUT)                       :: is_modified ! true if pctsrf is modified at this time step
    31114
    32115! Local variables
    33116!****************************************************************************************
    34     CHARACTER (len = 80)   :: abort_message
    35     CHARACTER (len = 20)   :: modname = 'ocean_slab_frac'
    36 
    37 
    38     IF (version_ocean == 'sicOBS') THEN   
    39        CALL limit_read_frac(itime, dtime, jour, pctsrf, is_modified)
     117
     118    IF (version_ocean == 'sicOBS'.OR. version_ocean == 'sicNO') THEN   
     119       CALL limit_read_frac(itime, dtime, jour, pctsrf_chg, is_modified)
    40120    ELSE
    41        abort_message='Ocean slab model without forced sea-ice fractions has to be rewritten!!!'
    42        CALL abort_gcm(modname,abort_message,1)
    43 ! Here should sea-ice/ocean fraction either be calculated or returned if saved as a module varaiable
    44 ! (in the case the new fractions are calculated in ocean_slab_ice or ocean_slab_noice subroutines). 
     121       pctsrf_chg(:,:)=pctsrf(:,:)
     122       is_modified=.TRUE.
    45123    END IF
    46124
    … …  
    57135       radsol, snow, agesno, &
    58136       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    59        tsurf_new, dflux_s, dflux_l, lmt_bils)
     137       tsurf_new, dflux_s, dflux_l, qflux)
    60138   
    61     USE dimphy
    62139    USE calcul_fluxs_mod
    63     USE indice_sol_mod
     140    USE surface_data
    64141
    65142    INCLUDE "iniprint.h"
    … …  
    95172    REAL, DIMENSION(klon), INTENT(OUT)   :: tsurf_new
    96173    REAL, DIMENSION(klon), INTENT(OUT)   :: dflux_s, dflux_l     
    97     REAL, DIMENSION(klon), INTENT(OUT)   :: lmt_bils
     174    REAL, DIMENSION(klon), INTENT(OUT)   :: qflux
    98175
    99176! Local variables
    100177!****************************************************************************************
    101     INTEGER               :: i
     178    INTEGER               :: i,ki
    102179    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
    103     REAL, DIMENSION(klon) :: lmt_bils_oce, lmt_foce, diff_sst
     180    REAL, DIMENSION(klon) :: diff_sst, lmt_bils
    104181    REAL, DIMENSION(klon) :: u0, v0
    105182    REAL, DIMENSION(klon) :: u1_lay, v1_lay
    106     REAL                  :: calc_bils_oce, deltat
    107     REAL, PARAMETER       :: cyang=50.0 * 4.228e+06 ! capacite calorifique volumetrique de l'eau J/(m2 K)
    108183
    109184!****************************************************************************************
    … …  
    136211         flux_u1, flux_v1) 
    137212
    138 !****************************************************************************************
    139 ! 2) Get global variables lmt_bils and lmt_foce from file limit_slab.nc
    140 !
    141 !****************************************************************************************
    142     CALL limit_slab(itime, dtime, jour, lmt_bils, lmt_foce, diff_sst)  ! global pour un processus
    143 
    144     lmt_bils_oce(:) = 0.
    145     WHERE (lmt_foce > 0.)
    146        lmt_bils_oce = lmt_bils / lmt_foce ! global
    147     END WHERE
     213! Accumulate total fluxes locally
     214    slab_bils(:)=0.
     215    DO i=1,knon
     216        ki=knindex(i)
     217        slab_bils(ki)=(fluxlat(i)+fluxsens(i)+radsol(i))*pctsrf(ki,is_oce)/(1.-zmasq(ki))
     218        bils_cum(ki)=bils_cum(ki)+slab_bils(ki)
     219! Also taux, tauy, saved vars...
     220    END DO
     221
     222!****************************************************************************************
     223! 2) Get global variables lmt_bils and diff_sst from file limit_slab.nc
     224!
     225!****************************************************************************************
     226    lmt_bils(:)=0.
     227    CALL limit_slab(itime, dtime, jour, lmt_bils, diff_sst)  ! global pour un processus
     228    ! lmt_bils and diff_sst saved by limit_slab
     229    qflux(:)=lmt_bils(:)+diff_sst(:)/cyang/86400.
     230    ! qflux = total QFlux correction (in W/m2)
    148231
    149232!****************************************************************************************
    150233! 3) Recalculate new temperature
    151234!
    152 !****************************************************************************************
    153     DO i = 1, knon
    154        calc_bils_oce = radsol(i) + fluxsens(i) + fluxlat(i)
    155        deltat        = (calc_bils_oce - lmt_bils_oce(knindex(i)))*dtime/cyang +diff_sst(knindex(i))
    156        tsurf_new(i)  = tsurf_in(i) + deltat
    157     END DO
    158 
     235!***********************************************o*****************************************
     236    tsurf_new=tsurf_in
     237    IF (MOD(itime,cpl_pas).EQ.0) THEN ! time to update tslab & fraction
     238        ! Compute transport
     239        ! Add read QFlux and SST tendency
     240        tslab(:,1)=tslab(:,1)+qflux(:)*cyang*dtime*cpl_pas
     241        ! Add cumulated surface fluxes
     242        tslab(:,1)=tslab(:,1)+bils_cum(:)*cyang*dtime
     243        ! Update surface temperature
     244        SELECT CASE(version_ocean)
     245        CASE('sicNO')
     246            DO i=1,knon
     247                ki=knindex(i)
     248                tsurf_new(i)=tslab(ki,1)
     249            END DO
     250        CASE('sicOBS') ! check for sea ice or tsurf below freezing
     251            DO i=1,knon
     252                ki=knindex(i)
     253                IF ((tslab(ki,1).LT.t_freeze).OR.(pctsrf(ki,is_sic).GT.epsfra)) THEN
     254                    tsurf_new(i)=t_freeze
     255                    tslab(ki,1)=t_freeze
     256                ELSE
     257                    tsurf_new(i)=tslab(ki,1)
     258                END IF
     259            END DO
     260        CASE('sicINT')
     261            DO i=1,knon
     262                ki=knindex(i)
     263                IF (pctsrf(ki,is_sic).LT.epsfra) THEN ! Free of ice
     264                    IF (tslab(ki,1).GT.t_freeze) THEN
     265                        tsurf_new(i)=tslab(ki,1)
     266                    ELSE
     267                        tsurf_new(i)=t_freeze
     268                        ! Call new ice routine
     269                        tslab(ki,1)=t_freeze
     270                    END IF
     271                ELSE ! ice present, tslab update completed in slab_ice
     272                    tsurf_new(i)=t_freeze
     273                END IF !ice free
     274            END DO
     275        END SELECT
     276        bils_cum(:)=0.0! clear cumulated fluxes
     277    END IF ! coupling time
    159278  END SUBROUTINE ocean_slab_noice
    160279!
    161280!****************************************************************************************
    162281!
     282!  SUBROUTINE ocean_slab_ice(   &
     283!       itime, dtime, jour, knon, knindex, &
     284!       tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     285!       AcoefH, AcoefQ, BcoefH, BcoefQ, &
     286!       AcoefU, AcoefV, BcoefU, BcoefV, &
     287!       ps, u1, v1, &
     288!       radsol, snow, qsurf, qsol, agesno, tsoil, &
     289!       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
     290!       tsurf_new, dflux_s, dflux_l)
     291!
     292!****************************************************************************************
     293! 1) Flux calculation
     294!****************************************************************************************
     295! set beta, cal etc. depends snow / ice surf ?
     296! calcul_fluxs (sens, lat etc)
     297! calcul_flux_wind
     298
     299!****************************************************************************************
     300! 2) Update surface
     301!****************************************************************************************
     302! neige, fonte
     303! flux glace-ocean
     304! update temperature
     305! neige precip, evap
     306! Melt snow & ice from above
     307! New albedo
     308
     309!****************************************************************************************
     310! 3) Recalculate new ocean temperature
     311!    Melt / freeze from below
     312!***********************************************o*****************************************
     313
     314
     315!  END SUBROUTINE ocean_slab_ice
     316!
     317!****************************************************************************************
     318!
     319  SUBROUTINE ocean_slab_final
     320  !, seaice_rst etc
     321
     322    ! For ok_xxx vars (Ekman...)
     323    INCLUDE "clesphys.h"
     324
     325!****************************************************************************************
     326! Deallocate module variables
     327!
     328!****************************************************************************************
     329    IF (ALLOCATED(pctsrf)) DEALLOCATE(pctsrf)
     330    IF (ALLOCATED(tslab)) DEALLOCATE(tslab)
     331
     332  END SUBROUTINE ocean_slab_final
     333
    163334END MODULE ocean_slab_mod

  • LMDZ5/branches/testing/libf/phylmd/phyetat0.F90

    r2056 r2073  
    33SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
    44
    5   USE dimphy, only: klon, zmasq, klev
     5  USE dimphy, only: klon, zmasq, klev, nslay
    66  USE iophy, ONLY : init_iophy_new
    77  USE ocean_cpl_mod,    ONLY : ocean_cpl_init
    … …  
    1515       solsw, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    1616       wake_deltat, wake_fip, wake_pe, wake_s, zgam, zmax0, zmea, zpic, zsig, &
    17        zstd, zthe, zval
     17       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
    1818  USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy
    1919  USE infotrac, only: nbtr, type_trac, tname, niadv
    … …  
    2121  USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send
    2222  USE indice_sol_mod, only: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
     23  USE ocean_slab_mod, ONLY: tslab, ocean_slab_init
    2324
    2425  IMPLICIT none
    … …  
    4041
    4142  REAL tsoil(klon, nsoilmx, nbsrf)
    42   REAL tslab(klon), seaice(klon)
    4343  REAL qsurf(klon, nbsrf)
    4444  REAL qsol(klon)
    … …  
    997997  PRINT*, '(ecart-type) detr_therm:', xmin, xmax
    998998
     999  CALL get_field("ALE_BL", ale_bl, found)
     1000  IF (.NOT. found) THEN
     1001     PRINT*, "phyetat0: Le champ <ale_bl> est absent"
     1002     PRINT*, "Depart legerement fausse. Mais je continue"
     1003     ale_bl=0.
     1004  ENDIF
     1005  xmin = 1.0E+20
     1006  xmax = -1.0E+20
     1007  xmin = MINval(ale_bl)
     1008  xmax = MAXval(ale_bl)
     1009  PRINT*, '(ecart-type) ale_bl:', xmin, xmax
     1010
     1011  CALL get_field("ALE_BL_TRIG", ale_bl_trig, found)
     1012  IF (.NOT. found) THEN
     1013     PRINT*, "phyetat0: Le champ <ale_bl_trig> est absent"
     1014     PRINT*, "Depart legerement fausse. Mais je continue"
     1015     ale_bl_trig=0.
     1016  ENDIF
     1017  xmin = 1.0E+20
     1018  xmax = -1.0E+20
     1019  xmin = MINval(ale_bl_trig)
     1020  xmax = MAXval(ale_bl_trig)
     1021  PRINT*, '(ecart-type) ale_bl_trig:', xmin, xmax
     1022
     1023  CALL get_field("ALP_BL", alp_bl, found)
     1024  IF (.NOT. found) THEN
     1025     PRINT*, "phyetat0: Le champ <alp_bl> est absent"
     1026     PRINT*, "Depart legerement fausse. Mais je continue"
     1027     alp_bl=0.
     1028  ENDIF
     1029  xmin = 1.0E+20
     1030  xmax = -1.0E+20
     1031  xmin = MINval(alp_bl)
     1032  xmax = MAXval(alp_bl)
     1033  PRINT*, '(ecart-type) alp_bl:', xmin, xmax
     1034
    9991035  ! Read and send field trs to traclmdz
    10001036
    … …  
    10451081  end if
    10461082
     1083  ! Initialize Slab variables
     1084  IF ( type_ocean == 'slab' ) THEN
     1085      ALLOCATE(tslab(klon,nslay), stat=ierr)
     1086      IF (ierr /= 0) CALL abort_gcm &
     1087         ('phyetat0', 'pb allocation tslab', 1)
     1088      CALL get_field("tslab", tslab, found)
     1089      IF (.NOT. found) THEN
     1090          PRINT*, "phyetat0: Le champ <tslab> est absent"
     1091          PRINT*, "Initialisation a tsol_oce"
     1092          DO i=1,nslay
     1093              tslab(:,i)=ftsol(:,is_oce)
     1094          END DO
     1095      END IF
     1096      print*, "calling slab_init"
     1097      CALL ocean_slab_init(dtime, pctsrf)
     1098  END IF ! Slab       
     1099
    10471100  ! on ferme le fichier
    10481101  CALL close_startphy

  • LMDZ5/branches/testing/libf/phylmd/phyredem.F90

    r1999 r2073  
    1515  USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
    1616  USE indice_sol_mod
     17  USE surface_data
     18  USE ocean_slab_mod, ONLY : tslab
    1719
    1820  IMPLICIT none
    … …  
    3335
    3436  REAL tsoil(klon, nsoilmx, nbsrf)
    35   REAL tslab(klon), seaice(klon)
    3637  REAL qsurf(klon, nbsrf)
    3738  REAL qsol(klon)
    … …  
    322323
    323324  CALL put_field("DETR_THERM", "DETR_THERM", detr_therm)
     325
     326  CALL put_field("ALE_BL", "ALE_BL", Ale_bl)
     327
     328  CALL put_field("ALE_BL_TRIG", "ALE_BL_TRIG", Ale_bl_trig)
     329
     330  CALL put_field("ALP_BL", "ALP_BL", Alp_bl)
    324331
    325332  ! trs from traclmdz_mod
    … …  
    340347  END IF
    341348
     349  ! Restart variables for Slab ocean
     350  IF (type_ocean == 'slab') THEN
     351      CALL put_field("tslab", "Slab ocean temperature", tslab)
     352  END IF
     353
    342354  if (ok_gwd_rando) then
    343355     call put_field("du_gwd_rando", &

  • LMDZ5/branches/testing/libf/phylmd/phys_output_ctrlout_mod.F90

    r2056 r2073  
    456456    !(/ ('', i=1, 9) /))
    457457  TYPE(ctrl_out), SAVE :: o_slab_bils = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11 /), &
    458     'slab_bils_oce', 'Bilan au sol sur ocean slab', 'W/m2', (/ ('', i=1, 9) /))
     458    'slab_bils', 'flux atmos - slab ponderes foce', 'W/m2', (/ ('', i=1, 9) /))
     459  TYPE(ctrl_out), SAVE :: o_slab_qflux = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11 /), &
     460    'slab_qflux', 'Correction flux slab', 'W/m2', (/ ('', i=1, 9) /))
     461  TYPE(ctrl_out), SAVE :: o_tslab = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11 /), &
     462    'tslab', 'Temperature ocean slab', 'K', (/ ('', i=1, 9) /))
    459463  TYPE(ctrl_out), SAVE :: o_ale_bl = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11 /), &
    460464    'ale_bl', 'ALE BL', 'm2/s2', (/ ('', i=1, 9) /))

  • LMDZ5/branches/testing/libf/phylmd/phys_output_write_mod.F90

    r2056 r2073  
    2424    ! defined and initialised in phys_output_mod.F90
    2525
    26     USE dimphy, only: klon, klev, klevp1
     26    USE dimphy, only: klon, klev, klevp1, nslay
    2727    USE control_mod, only: day_step, iphysiq
    2828    USE phys_output_ctrlout_mod, only: o_phis, o_aire, is_ter, is_lic, is_oce, &
    … …  
    7777         o_ale_bl_trig, o_alp_bl_det, &
    7878         o_alp_bl_fluct_m, o_alp_bl_fluct_tke, &
    79          o_alp_bl_conv, o_alp_bl_stat, o_slab_bils, &
     79         o_alp_bl_conv, o_alp_bl_stat, &
     80         o_slab_qflux, o_tslab, o_slab_bils, &
    8081         o_weakinv, o_dthmin, o_cldtau, &
    8182         o_cldemi, o_pr_con_l, o_pr_con_i, &
    … …  
    219220         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    220221         itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando
     222    USE ocean_slab_mod, only: tslab, slab_bils
    221223    USE indice_sol_mod, only: nbsrf
    222224    USE infotrac, only: nqtot
    … …  
    726728       ENDIF  !(iflag_clos_bl>=1)
    727729!!! fin nrlmd le 10/04/2012
     730       ! Output of slab ocean variables
    728731       IF (type_ocean=='slab ') THEN
    729           CALL histwrite_phy(o_slab_bils, slab_wfbils)
     732          CALL histwrite_phy(o_slab_qflux, slab_wfbils)
     733          CALL histwrite_phy(o_slab_bils, slab_bils)
     734          IF (nslay.EQ.1) THEN
     735              zx_tmp_fi2d(:)=tslab(:,1)
     736              CALL histwrite_phy(o_tslab, zx_tmp_fi2d)
     737          ELSE
     738              CALL histwrite_phy(o_tslab, tslab)
     739          END IF
    730740       ENDIF !type_ocean == force/slab
    731741       CALL histwrite_phy(o_weakinv, weak_inversion)

  • LMDZ5/branches/testing/libf/phylmd/physiq.F90

    r2056 r2073  
    442442  REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    443443  ! RomP <<<
    444  
     444
    445445  REAL          :: calday
    446446
    … …  
    489489  EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
    490490  !AA
    491 ! JBM (3/14) fisrtilp_tr not loaded
    492 ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
     491  ! JBM (3/14) fisrtilp_tr not loaded
     492  ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
    493493  !                          ! stockage des coefficients necessaires au
    494494  !                          ! lessivage OFF-LINE et ON-LINE
    … …  
    542542
    543543  !
    544 !  REAL zxsnow(klon)
     544  !  REAL zxsnow(klon)
    545545  REAL zxsnow_dummy(klon)
    546546  !
    … …  
    636636  !======================================================================
    637637  !
    638  
     638
    639639  !
    640640  integer itau_w   ! pas de temps ecriture = itap + itau_phy
    … …  
    689689  !
    690690  !IM 280405 BEG
    691 !  INTEGER nid_bilKPins, nid_bilKPave
    692 !  SAVE nid_bilKPins, nid_bilKPave
    693 !  !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
     691  !  INTEGER nid_bilKPins, nid_bilKPave
     692  !  SAVE nid_bilKPins, nid_bilKPave
     693  !  !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
    694694  !
    695695  REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
    … …  
    701701  REAL zsto
    702702  REAL zstophy, zout
    703  
     703
    704704  real zjulian
    705705  save zjulian
    … …  
    11211121        endif
    11221122
    1123         do i = 1,klon
    1124            Ale_bl(i)=0.
    1125            Alp_bl(i)=0.
    1126         enddo
     1123!        do i = 1,klon
     1124!           Ale_bl(i)=0.
     1125!           Alp_bl(i)=0.
     1126!        enddo
    11271127
    11281128        !================================================================================
    … …  
    15881588
    15891589     IF (solarlong0<-999.) then
    1590      ! Generic case with evolvoing season
     1590        ! Generic case with evolvoing season
    15911591        zzz=real(days_elapsed+1)
    15921592     ELSE IF (abs(solarlong0-1000.)<1.e-4) then
    1593      ! Particular case with annual mean insolation
     1593        ! Particular case with annual mean insolation
    15941594        zzz=real(90) ! could be revisited
    15951595        IF (read_climoz/=-1) THEN
    … …  
    15981598        ENDIF
    15991599     ELSE
    1600      ! Case where the season is imposed with solarlong0
     1600        ! Case where the season is imposed with solarlong0
    16011601        zzz=real(90) ! could be revisited
    16021602     ENDIF
    … …  
    17641764     IF (klon_glo==1) THEN
    17651765        CALL add_pbl_tend &
    1766           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
     1766             (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
    17671767     ELSE
    17681768        CALL add_phys_tend &
    1769           (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
     1769             (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,paprs,'vdf')
    17701770     ENDIF
    17711771     !--------------------------------------------------------------------
    … …  
    19871987!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    19881988
     1989
    19891990     endif
    19901991     do i=1,klon
    … …  
    23692370                   s_trig,s2,n2
    23702371           ENDIF
    2371  
    2372 !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
     2372
     2373           !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
    23732374           IF (iflag_trig_bl.eq.1) then
    23742375
    2375            !----Tirage al\'eatoire et calcul de ale_bl_trig
    2376            do i=1,klon
    2377               if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
    2378                  proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2379                       (n2(i)*dtime/tau_trig(i))
    2380                  !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2381                  if (random_notrig(i) .ge. proba_notrig(i)) then
    2382                     ale_bl_trig(i)=ale_bl_stat(i)
     2376              !----Tirage al\'eatoire et calcul de ale_bl_trig
     2377              do i=1,klon
     2378                 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
     2379                    proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
     2380                         (n2(i)*dtime/tau_trig(i))
     2381                    !        print *, 'proba_notrig(i) ',proba_notrig(i)
     2382                    if (random_notrig(i) .ge. proba_notrig(i)) then
     2383                       ale_bl_trig(i)=ale_bl_stat(i)
     2384                    else
     2385                       ale_bl_trig(i)=0.
     2386                    endif
    23832387                 else
     2388                    proba_notrig(i)=1.
     2389                    random_notrig(i)=0.
    23842390                    ale_bl_trig(i)=0.
    23852391                 endif
    2386               else
    2387                  proba_notrig(i)=1.
    2388                  random_notrig(i)=0.
    2389                  ale_bl_trig(i)=0.
    2390               endif
    2391            enddo
     2392              enddo
    23922393
    23932394           ELSE IF (iflag_trig_bl.eq.2) then
    23942395
    2395            do i=1,klon
    2396               if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
    2397                  proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2398                       (n2(i)*dtime/tau_trig(i))
    2399                  !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2400                  if (random_notrig(i) .ge. proba_notrig(i)) then
    2401                     ale_bl_trig(i)=Ale_bl(i)
     2396              do i=1,klon
     2397                 if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
     2398                    proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
     2399                         (n2(i)*dtime/tau_trig(i))
     2400                    !        print *, 'proba_notrig(i) ',proba_notrig(i)
     2401                    if (random_notrig(i) .ge. proba_notrig(i)) then
     2402                       ale_bl_trig(i)=Ale_bl(i)
     2403                    else
     2404                       ale_bl_trig(i)=0.
     2405                    endif
    24022406                 else
     2407                    proba_notrig(i)=1.
     2408                    random_notrig(i)=0.
    24032409                    ale_bl_trig(i)=0.
    24042410                 endif
    2405               else
    2406                  proba_notrig(i)=1.
    2407                  random_notrig(i)=0.
    2408                  ale_bl_trig(i)=0.
    2409               endif
    2410            enddo
     2411              enddo
    24112412
    24122413           ENDIF
    … …  
    24242425
    24252426           do i=1,klon
    2426 !CR: alp probabiliste
    2427                if (ale_bl_trig(i).gt.0.) then
    2428                   alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
    2429                endif
    2430            enddo       
    2431  
     2427              !CR: alp probabiliste
     2428              if (ale_bl_trig(i).gt.0.) then
     2429                 alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
     2430              endif
     2431           enddo
     2432
    24322433        else if (iflag_clos_bl.eq.2) then
    24332434
    2434 !CR: alp calculee dans thermcell_main
     2435           !CR: alp calculee dans thermcell_main
    24352436           do i=1,klon
    24362437              alp_bl(i)=alp_bl_stat(i)
    … …  
    24692470
    24702471        do i=1,klon
    2471 !           zmax_th(i)=pphi(i,lmax_th(i))/rg
    2472 !CR:04/05/12:correction calcul zmax
    2473          zmax_th(i)=zmax0(i)
     2472           !           zmax_th(i)=pphi(i,lmax_th(i))/rg
     2473           !CR:04/05/12:correction calcul zmax
     2474           zmax_th(i)=zmax0(i)
    24742475        enddo
    24752476
    … …  
    25002501
    25012502        if (iflag_thermals==0) then
    2502         ! Calling adjustment alone (but not the thermal plume model)
     2503           ! Calling adjustment alone (but not the thermal plume model)
    25032504           CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
    25042505                , d_t_ajsb, d_q_ajsb)
    25052506        else if (iflag_thermals>0) then
    2506         ! Calling adjustment above the top of thermal plumes
     2507           ! Calling adjustment above the top of thermal plumes
    25072508           CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
    25082509                , d_t_ajsb, d_q_ajsb)
    … …  
    26782679        IF (.NOT. aerosol_couple) THEN
    26792680           IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    2680 !
    2681              CALL readaerosol_optic( &
    2682              debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    2683              pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    2684              mass_solu_aero, mass_solu_aero_pi,  &
    2685              tau_aero, piz_aero, cg_aero,  &
    2686              tausum_aero, tau3d_aero)
    2687 !
     2681              !
     2682              CALL readaerosol_optic( &
     2683                   debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     2684                   pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     2685                   mass_solu_aero, mass_solu_aero_pi,  &
     2686                   tau_aero, piz_aero, cg_aero,  &
     2687                   tausum_aero, tau3d_aero)
     2688              !
    26882689           ELSE                       ! RRTM radiation
    2689 !
     2690              !
    26902691#ifdef CPP_RRTM
    2691              CALL readaerosol_optic_rrtm( &
    2692              debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    2693              pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    2694              mass_solu_aero, mass_solu_aero_pi,  &
    2695              tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,  &
    2696              tausum_aero, tau3d_aero)
     2692              CALL readaerosol_optic_rrtm( &
     2693                   debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     2694                   pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     2695                   mass_solu_aero, mass_solu_aero_pi,  &
     2696                   tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,  &
     2697                   tausum_aero, tau3d_aero)
    26972698#else
    26982699
    2699             abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    2700             call abort_gcm(modname,abort_message,1)
     2700              abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2701              call abort_gcm(modname,abort_message,1)
    27012702#endif
    2702 !
     2703              !
    27032704           ENDIF
    27042705        ENDIF
    … …  
    27062707        tausum_aero(:,:,:) = 0.
    27072708        IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    2708           tau_aero(:,:,:,:) = 0.
    2709           piz_aero(:,:,:,:) = 0.
    2710           cg_aero(:,:,:,:)  = 0.
     2709           tau_aero(:,:,:,:) = 0.
     2710           piz_aero(:,:,:,:) = 0.
     2711           cg_aero(:,:,:,:)  = 0.
    27112712        ELSE
    2712           tau_aero_rrtm(:,:,:,:)=0.0
    2713           piz_aero_rrtm(:,:,:,:)=0.0
    2714           cg_aero_rrtm(:,:,:,:)=0.0
     2713           tau_aero_rrtm(:,:,:,:)=0.0
     2714           piz_aero_rrtm(:,:,:,:)=0.0
     2715           cg_aero_rrtm(:,:,:,:)=0.0
    27152716        ENDIF
    27162717     ENDIF
    … …  
    27212722        PRINT *,'appel a readaerosolstrat', mth_cur
    27222723        IF (iflag_rrtm.EQ.0) THEN
    2723          CALL readaerosolstrato(debut)
     2724           CALL readaerosolstrato(debut)
    27242725        ELSE
    27252726#ifdef CPP_RRTM
    2726          CALL readaerosolstrato_rrtm(debut)
     2727           CALL readaerosolstrato_rrtm(debut)
    27272728#else
    27282729
    2729          abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    2730          call abort_gcm(modname,abort_message,1)
     2730           abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2731           call abort_gcm(modname,abort_message,1)
    27312732#endif
    27322733        ENDIF
    … …  
    29512952     IF (iflag_rrtm.NE.0) THEN
    29522953#ifdef CPP_RRTM
    2953        IF (ok_cdnc.AND.NRADLP.NE.3) THEN
    2954          abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'
    2955          call abort_gcm(modname,abort_message,1)
    2956        endif
     2954        IF (ok_cdnc.AND.NRADLP.NE.3) THEN
     2955           abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'
     2956           call abort_gcm(modname,abort_message,1)
     2957        endif
    29572958#else
    29582959
    2959        abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    2960        call abort_gcm(modname,abort_message,1)
     2960        abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
     2961        call abort_gcm(modname,abort_message,1)
    29612962#endif
    29622963     ENDIF

  • LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90

    r2056 r2073  
    1212  USE aero_mod
    1313  USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer
     14  USE YOMCST           , only : RD , RG
    1415
    1516  !
    … …  
    4950  !
    5051  IMPLICIT NONE
    51   INCLUDE "YOMCST.h"
    5252  !
    5353  ! Input arguments:

  • LMDZ5/branches/testing/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90

    r2056 r2073  
    1111  USE aero_mod
    1212  USE phys_local_var_mod, only: absvisaer
     13  USE YOMCST            , only: RD , RG
    1314
    1415  !    Yves Balkanski le 12 avril 2006
    … …  
    2122  IMPLICIT NONE
    2223
    23   INCLUDE "YOMCST.h"
    2424  INCLUDE "iniprint.h"
    2525  INCLUDE "clesphys.h"

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90

    r2056 r2073  
    1919    implicit none
    2020
    21     include "YOMCST.h"
    2221    include "dimensions.h"
    2322

  • LMDZ5/branches/testing/libf/phylmd/rrtm/yoesw.F90

    r2056 r2073  
    1515REAL(KIND=JPRB) :: RRAY(6,6)
    1616REAL(KIND=JPRB), ALLOCATABLE :: RSUN(:)
     17!$OMP THREADPRIVATE(RSUN)
    1718REAL(KIND=JPRB) :: RPDH1
    1819REAL(KIND=JPRB) :: RPDU1

  • LMDZ5/branches/testing/libf/phylmd/surf_ocean_mod.F90

    r1910 r2073  
    138138
    139139!****************************************************************************************
     140! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
     141!****************************************************************************************
     142    IF (type_ocean.NE.'slab') THEN
     143        lmt_bils(:)=0.
     144        DO i=1,knon
     145           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
     146           *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
     147        END DO
     148    END IF
     149
     150!****************************************************************************************
    140151! Calculate albedo
    141152!

  • LMDZ5/branches/testing/libf/phylmd/surf_seaice_mod.F90

    r1910 r2073  
    108108            tsurf_new, dflux_s, dflux_l)
    109109       
    110     ELSE IF (type_ocean == 'force' .OR. (type_ocean == 'slab' .AND. version_ocean=='sicOBS')) THEN
     110!    ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
     111!       CALL ocean_slab_ice( &
     112!          itime, dtime, jour, knon, knindex, &
     113!          debut, &
     114!          tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, spechum,&
     115!          AcoefH, AcoefQ, BcoefH, BcoefQ, &
     116!          ps, u1, v1, &
     117!          radsol, snow, qsurf, qsol, agesno, tsoil, &
     118!          alb1_new, alb2_new, evap, fluxsens, fluxlat, &
     119!          tsurf_new, dflux_s, dflux_l)
     120!
     121      ELSE ! type_ocean=force or slab +sicOBS or sicNO
    111122       CALL ocean_forced_ice( &
    112123            itime, dtime, jour, knon, knindex, &
    … …  
    118129            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    119130            tsurf_new, dflux_s, dflux_l)
    120 
    121     ELSE IF (type_ocean == 'slab') THEN
    122 !!$       CALL ocean_slab_ice( &
    123 !!$          itime, dtime, jour, knon, knindex, &
    124 !!$          debut, &
    125 !!$          tsurf, p1lay, cdragh, precip_rain, precip_snow, temp_air, spechum,&
    126 !!$          AcoefH, AcoefQ, BcoefH, BcoefQ, &
    127 !!$          ps, u1, v1, pctsrf, &
    128 !!$          radsol, snow, qsurf, qsol, agesno, tsoil, &
    129 !!$          alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    130 !!$          tsurf_new, dflux_s, dflux_l)
    131131
    132132    END IF

  • LMDZ5/branches/testing/libf/phylmd/surface_data.F90

    r1910 r2073  
    77  REAL, PARAMETER        :: tau_gl=86400.*5.
    88  REAL, PARAMETER        :: calsno=1./(2.3867e+06*.15)
     9  REAL, PARAMETER        :: t_freeze=271.35
     10  REAL, PARAMETER        :: t_melt=273.15
    911 
    1012  LOGICAL, SAVE          :: ok_veget      ! true for use of vegetation model ORCHIDEE
    … …  
    2022
    2123  ! if type_ocean=couple : version_ocean=opa8 ou nemo
    22   ! if type_ocean=slab   : version_ocean=sicOBS
     24  ! if type_ocean=slab   : version_ocean=sicOBS or sicINT or sicNO
    2325  CHARACTER(len=6), SAVE :: version_ocean
    2426  !$OMP THREADPRIVATE(version_ocean)
Note: See TracChangeset for help on using the changeset viewer.