Ignore:
Timestamp:
Jul 29, 2024, 11:01:04 PM (3 months ago)
Author:
abarral
Message:

Put YOMCST.h into modules

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ocean_cpl_mod.F90

    r5137 r5144  
    1 
    21! $Id$
    32
    43MODULE ocean_cpl_mod
    54
    6 ! This module is used both for the sub-surface ocean and sea-ice for the case of a
    7 ! coupled model configuration, ocean=couple.
     5  ! This module is used both for the sub-surface ocean and sea-ice for the case of a
     6  ! coupled model configuration, ocean=couple.
    87
    98  IMPLICIT NONE
    … …  
    1312
    1413
    15 !****************************************************************************************
     14  !****************************************************************************************
    1615
    1716CONTAINS
    1817
    19 !****************************************************************************************
     18  !****************************************************************************************
    2019
    2120  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
    2221
    23 ! Allocate fields for this module and initailize the module mod_cpl
    24 
    25     USE dimphy,           ONLY: klon
     22    ! Allocate fields for this module and initailize the module mod_cpl
     23
     24    USE dimphy, ONLY: klon
    2625    USE cpl_mod
    2726
    28 ! Input arguments
    29 !*************************************************************************************
    30     REAL, INTENT(IN)                  :: dtime
     27    ! Input arguments
     28    !*************************************************************************************
     29    REAL, INTENT(IN) :: dtime
    3130    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
    3231
    33 ! Local variables
    34 !*************************************************************************************
    35     INTEGER              :: error
     32    ! Local variables
     33    !*************************************************************************************
     34    INTEGER :: error
    3635    CHARACTER (len = 80) :: abort_message
    3736    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
    3837
    39 ! Initialize module cpl_init
     38    ! Initialize module cpl_init
    4039    CALL cpl_init(dtime, rlon, rlat)
    41    
     40
    4241  END SUBROUTINE ocean_cpl_init
    4342
    44 !****************************************************************************************
    45 
    46   SUBROUTINE ocean_cpl_noice( &
    47        swnet, lwnet, alb1, &
    48        windsp, fder_old, &
    49        itime, dtime, knon, knindex, &
    50        p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
    51        AcoefH, AcoefQ, BcoefH, BcoefQ, &
    52        AcoefU, AcoefV, BcoefU, BcoefV, &
    53        ps, u1, v1, gustiness, tsurf_in, &
    54        radsol, snow, agesno, &
    55        qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    56        tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
    57        delta_sst, dTer, dSer, dt_ds)
    58 
    59 ! This SUBROUTINE treats the "open ocean", all grid points that are not entierly covered
    60 ! by ice. The SUBROUTINE first receives fields from coupler, then some calculations at
    61 ! surface is done and finally it sends some fields to the coupler.
    62 
    63     USE dimphy,           ONLY: klon
     43  !****************************************************************************************
     44
     45  SUBROUTINE ocean_cpl_noice(&
     46          swnet, lwnet, alb1, &
     47          windsp, fder_old, &
     48          itime, dtime, knon, knindex, &
     49          p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     50          AcoefH, AcoefQ, BcoefH, BcoefQ, &
     51          AcoefU, AcoefV, BcoefU, BcoefV, &
     52          ps, u1, v1, gustiness, tsurf_in, &
     53          radsol, snow, agesno, &
     54          qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
     55          tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
     56          delta_sst, dTer, dSer, dt_ds)
     57
     58    ! This SUBROUTINE treats the "open ocean", all grid points that are not entierly covered
     59    ! by ice. The SUBROUTINE first receives fields from coupler, then some calculations at
     60    ! surface is done and finally it sends some fields to the coupler.
     61
     62    USE dimphy, ONLY: klon
    6463    USE calcul_fluxs_mod
    6564    USE indice_sol_mod
    6665    USE phys_output_var_mod, ONLY: sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
    6766    USE cpl_mod, ONLY: gath2cpl, cpl_receive_ocean_fields, &
    68          cpl_send_ocean_fields
     67            cpl_send_ocean_fields
    6968    USE config_ocean_skin_m, ONLY: activate_ocean_skin
    7069    USE lmdz_clesphys
    71 
    72     INCLUDE "YOMCST.h"
    73 
    74 ! Input arguments 
    75 !****************************************************************************************
    76     INTEGER, INTENT(IN)                      :: itime, knon
    77     INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
    78     REAL, INTENT(IN)                         :: dtime
    79     REAL, DIMENSION(klon), INTENT(IN)        :: swnet
    80     REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
    81     REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
    82     REAL, DIMENSION(klon), INTENT(IN)        :: windsp
    83     REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
    84     REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    85     REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
    86     REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    87     REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    88     REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
    89     REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    90     REAL, DIMENSION(klon), INTENT(IN)        :: ps
    91     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
     70    USE lmdz_yomcst
     71
     72    IMPLICIT NONE
     73
     74    ! Input arguments
     75    !****************************************************************************************
     76    INTEGER, INTENT(IN) :: itime, knon
     77    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
     78    REAL, INTENT(IN) :: dtime
     79    REAL, DIMENSION(klon), INTENT(IN) :: swnet
     80    REAL, DIMENSION(klon), INTENT(IN) :: lwnet
     81    REAL, DIMENSION(klon), INTENT(IN) :: alb1   ! albedo in visible SW interval
     82    REAL, DIMENSION(klon), INTENT(IN) :: windsp
     83    REAL, DIMENSION(klon), INTENT(IN) :: fder_old
     84    REAL, DIMENSION(klon), INTENT(IN) :: p1lay
     85    REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragq, cdragm
     86    REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
     87    REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
     88    REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
     89    REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
     90    REAL, DIMENSION(klon), INTENT(IN) :: ps
     91    REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
    9292    REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
    9393
    94     REAL, INTENT(IN):: delta_sal(:) ! (knon)
     94    REAL, INTENT(IN) :: delta_sal(:) ! (knon)
    9595    ! ocean-air interface salinity minus bulk salinity, in ppt
    9696
    97     REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
    98 
    99     REAL, INTENT(IN):: delta_sst(:) ! (knon)
     97    REAL, INTENT(IN) :: rhoa(:) ! (knon) density of moist air  (kg / m3)
     98
     99    REAL, INTENT(IN) :: delta_sst(:) ! (knon)
    100100    ! Ocean-air interface temperature minus bulk SST, in K. Defined
    101101    ! only if activate_ocean_skin >= 1.
    102102
    103     REAL, INTENT(IN):: dter(:) ! (knon)
     103    REAL, INTENT(IN) :: dter(:) ! (knon)
    104104    ! Temperature variation in the diffusive microlayer, that is
    105105    ! ocean-air interface temperature minus subskin temperature. In
    106106    ! K.
    107107
    108     REAL, INTENT(IN):: dser(:) ! (knon)
     108    REAL, INTENT(IN) :: dser(:) ! (knon)
    109109    ! Salinity variation in the diffusive microlayer, that is
    110110    ! ocean-air interface salinity minus subskin salinity. In ppt.
    111111
    112     REAL, INTENT(IN):: dt_ds(:) ! (knon)
     112    REAL, INTENT(IN) :: dt_ds(:) ! (knon)
    113113    ! (tks / tkt) * dTer, in K
    114114
    115 ! In/Output arguments
    116 !****************************************************************************************
    117     REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
    118     REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
    119     REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
    120  
    121 ! Output arguments
    122 !****************************************************************************************
    123     REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
    124     REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    125     REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    126     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    127     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    128     REAL, INTENT(OUT):: sens_prec_liq(:) ! (knon)
    129 
    130     REAL, INTENT(OUT):: sss(:) ! (klon)
     115    ! In/Output arguments
     116    !****************************************************************************************
     117    REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
     118    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
     119    REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
     120
     121    ! Output arguments
     122    !****************************************************************************************
     123    REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
     124    REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
     125    REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
     126    REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
     127    REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
     128    REAL, INTENT(OUT) :: sens_prec_liq(:) ! (knon)
     129
     130    REAL, INTENT(OUT) :: sss(:) ! (klon)
    131131    ! bulk salinity of the surface layer of the ocean, in ppt
    132  
    133 
    134 ! Local variables
    135 !****************************************************************************************
    136     INTEGER               :: i, j
     132
     133
     134    ! Local variables
     135    !****************************************************************************************
     136    INTEGER :: i, j
    137137    INTEGER, DIMENSION(1) :: iloc
    138138    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
    … …  
    141141    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
    142142    REAL, DIMENSION(klon) :: u1_lay, v1_lay
    143     LOGICAL               :: check=.FALSE.
    144     REAL sens_prec_sol(knon) 
    145     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
    146 
    147 ! End definitions
    148 !****************************************************************************************
    149 
    150     IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
    151 
    152 !****************************************************************************************
    153 ! Receive sea-surface temperature(tsurf_cpl) from coupler
    154 
    155 !****************************************************************************************
     143    LOGICAL :: check = .FALSE.
     144    REAL sens_prec_sol(knon)
     145    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
     146
     147    ! End definitions
     148    !****************************************************************************************
     149
     150    IF (check) WRITE(*, *)' Entering ocean_cpl_noice'
     151
     152    !****************************************************************************************
     153    ! Receive sea-surface temperature(tsurf_cpl) from coupler
     154
     155    !****************************************************************************************
    156156    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
    157          sss)
    158 
    159 !****************************************************************************************
    160 ! Calculate fluxes at surface
    161 
    162 !****************************************************************************************
     157            sss)
     158
     159    !****************************************************************************************
     160    ! Calculate fluxes at surface
     161
     162    !****************************************************************************************
    163163    cal = 0.
    164164    beta = 1.
    … …  
    166166    agesno(:) = 0.
    167167    lat_prec_liq = 0.; lat_prec_sol = 0.
    168    
    169168
    170169    DO i = 1, knon
    171        u1_lay(i) = u1(i) - u0_cpl(i)
    172        v1_lay(i) = v1(i) - v0_cpl(i)
     170      u1_lay(i) = u1(i) - u0_cpl(i)
     171      v1_lay(i) = v1(i) - v0_cpl(i)
    173172    END DO
    174173
    175174    CALL calcul_fluxs(knon, is_oce, dtime, &
    176          merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
    177          beta, cdragh, cdragq, ps, &
    178          precip_rain, precip_snow, snow, qsurf, &
    179          radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
    180          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
    181          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    182          sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
     175            merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
     176            beta, cdragh, cdragq, ps, &
     177            precip_rain, precip_snow, snow, qsurf, &
     178            radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
     179            f_qsat_oce, AcoefH, AcoefQ, BcoefH, BcoefQ, &
     180            tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
     181            sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
    183182
    184183    IF (activate_ocean_skin == 2) THEN
    185        ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
    186        ! the new bulk SST tsurf_cpl:
    187        tsurf_new = tsurf_cpl
     184      ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
     185      ! the new bulk SST tsurf_cpl:
     186      tsurf_new = tsurf_cpl
    188187    end if
    189188
    190189    ! assertion: tsurf_new == tsurf_cpl
    191    
     190
    192191    do j = 1, knon
    193192      i = knindex(j)
    194       sens_prec_liq_o(i,1) = sens_prec_liq(j)
    195       sens_prec_sol_o(i,1) = sens_prec_sol(j)
    196       lat_prec_liq_o(i,1) = lat_prec_liq(j)
    197       lat_prec_sol_o(i,1) = lat_prec_sol(j)
     193      sens_prec_liq_o(i, 1) = sens_prec_liq(j)
     194      sens_prec_sol_o(i, 1) = sens_prec_sol(j)
     195      lat_prec_liq_o(i, 1) = lat_prec_liq(j)
     196      lat_prec_sol_o(i, 1) = lat_prec_sol(j)
    198197    enddo
    199198
    200199
    201    
    202 ! - Flux calculation at first modele level for U and V
     200
     201    ! - Flux calculation at first modele level for U and V
    203202    CALL calcul_flux_wind(knon, dtime, &
    204          u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
    205          AcoefU, AcoefV, BcoefU, BcoefV, &
    206          p1lay, temp_air, &
    207          flux_u1, flux_v1) 
    208 
    209 !****************************************************************************************
    210 ! Calculate fder : flux derivative (sensible and latente)
    211 
    212 !****************************************************************************************
     203            u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
     204            AcoefU, AcoefV, BcoefU, BcoefV, &
     205            p1lay, temp_air, &
     206            flux_u1, flux_v1)
     207
     208    !****************************************************************************************
     209    ! Calculate fder : flux derivative (sensible and latente)
     210
     211    !****************************************************************************************
    213212    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
    214    
     213
    215214    iloc = MAXLOC(fder_new(1:klon))
    216215    IF (check .AND. fder_new(iloc(1))> 0.) THEN
    217        WRITE(*,*)'**** Debug fder****'
    218        WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
    219        WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
    220             dflux_s(iloc(1)), dflux_l(iloc(1))
     216      WRITE(*, *)'**** Debug fder****'
     217      WRITE(*, *)'max fder(', iloc(1), ') = ', fder_new(iloc(1))
     218      WRITE(*, *)'fder_old, dflux_s, dflux_l', fder_old(iloc(1)), &
     219              dflux_s(iloc(1)), dflux_l(iloc(1))
    221220    ENDIF
    222221
    223 !****************************************************************************************
    224 ! Send and cumulate fields to the coupler
    225 
    226 !****************************************************************************************
     222    !****************************************************************************************
     223    ! Send and cumulate fields to the coupler
     224
     225    !****************************************************************************************
    227226
    228227    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
    229          fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
    230          flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
    231          lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
     228            fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
     229            flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
     230            lat_prec_sol, delta_sst, delta_sal, dTer, dSer, dt_ds)
    232231
    233232  END SUBROUTINE ocean_cpl_noice
    234233
    235 !****************************************************************************************
    236 
    237   SUBROUTINE ocean_cpl_ice( &
    238        rlon, rlat, swnet, lwnet, alb1, &
    239        fder_old, &
    240        itime, dtime, knon, knindex, &
    241        lafin, &
    242        p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
    243        AcoefH, AcoefQ, BcoefH, BcoefQ, &
    244        AcoefU, AcoefV, BcoefU, BcoefV, &
    245        ps, u1, v1, gustiness, pctsrf, &
    246        radsol, snow, qsurf, &
    247        alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    248        tsurf_new, dflux_s, dflux_l, rhoa)
    249 
    250 ! This SUBROUTINE treats the ocean where there is ice. The SUBROUTINE first receives
    251 ! fields from coupler, then some calculations at surface is done and finally sends
    252 ! some fields to the coupler.
    253 
    254     USE dimphy,           ONLY: klon
     234  !****************************************************************************************
     235
     236  SUBROUTINE ocean_cpl_ice(&
     237          rlon, rlat, swnet, lwnet, alb1, &
     238          fder_old, &
     239          itime, dtime, knon, knindex, &
     240          lafin, &
     241          p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
     242          AcoefH, AcoefQ, BcoefH, BcoefQ, &
     243          AcoefU, AcoefV, BcoefU, BcoefV, &
     244          ps, u1, v1, gustiness, pctsrf, &
     245          radsol, snow, qsurf, &
     246          alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
     247          tsurf_new, dflux_s, dflux_l, rhoa)
     248
     249    ! This SUBROUTINE treats the ocean where there is ice. The SUBROUTINE first receives
     250    ! fields from coupler, then some calculations at surface is done and finally sends
     251    ! some fields to the coupler.
     252
     253    USE dimphy, ONLY: klon
    255254    USE cpl_mod
    256255    USE calcul_fluxs_mod
    … …  
    258257    USE phys_output_var_mod, ONLY: sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
    259258    USE lmdz_clesphys
    260 
    261     INCLUDE "YOMCST.h"
    262 
    263 ! Input arguments
    264 !****************************************************************************************
    265     INTEGER, INTENT(IN)                      :: itime, knon
    266     INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
    267     LOGICAL, INTENT(IN)                      :: lafin
    268     REAL, INTENT(IN)                         :: dtime
    269     REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
    270     REAL, DIMENSION(klon), INTENT(IN)        :: swnet
    271     REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
    272     REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
    273     REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
    274     REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
    275     REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
    276     REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
    277     REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
    278     REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
    279     REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
    280     REAL, DIMENSION(klon), INTENT(IN)        :: ps
    281     REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
    282     REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    283     REAL, INTENT(IN):: rhoa(:) ! (knon) density of moist air  (kg / m3)
    284 
    285 ! In/output arguments
    286 !****************************************************************************************
    287     REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
    288     REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
    289 
    290 ! Output arguments
    291 !****************************************************************************************
    292     REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
    293     REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
    294     REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    295     REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    296     REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    297     REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    298  
    299 
    300 ! Local variables
    301 !****************************************************************************************
    302     INTEGER                 :: i, j
    303     INTEGER, DIMENSION(1)   :: iloc
    304     LOGICAL                 :: check=.FALSE.
    305     REAL, PARAMETER         :: t_grnd=271.35
    306     REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
    307     REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
    308     REAL, DIMENSION(klon)   :: alb_cpl
    309     REAL, DIMENSION(klon)   :: u0, v0
    310     REAL, DIMENSION(klon)   :: u1_lay, v1_lay
    311     REAL sens_prec_liq(knon), sens_prec_sol(knon)   
    312     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
    313 
    314 ! End definitions
    315 !****************************************************************************************
    316    
    317     IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
     259    USE lmdz_yomcst
     260
     261    IMPLICIT NONE
     262
     263    ! Input arguments
     264    !****************************************************************************************
     265    INTEGER, INTENT(IN) :: itime, knon
     266    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
     267    LOGICAL, INTENT(IN) :: lafin
     268    REAL, INTENT(IN) :: dtime
     269    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
     270    REAL, DIMENSION(klon), INTENT(IN) :: swnet
     271    REAL, DIMENSION(klon), INTENT(IN) :: lwnet
     272    REAL, DIMENSION(klon), INTENT(IN) :: alb1   ! albedo in visible SW interval
     273    REAL, DIMENSION(klon), INTENT(IN) :: fder_old
     274    REAL, DIMENSION(klon), INTENT(IN) :: p1lay
     275    REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
     276    REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
     277    REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
     278    REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
     279    REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
     280    REAL, DIMENSION(klon), INTENT(IN) :: ps
     281    REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
     282    REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: pctsrf
     283    REAL, INTENT(IN) :: rhoa(:) ! (knon) density of moist air  (kg / m3)
     284
     285    ! In/output arguments
     286    !****************************************************************************************
     287    REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
     288    REAL, DIMENSION(klon), INTENT(INOUT) :: snow
     289
     290    ! Output arguments
     291    !****************************************************************************************
     292    REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
     293    REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
     294    REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
     295    REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
     296    REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
     297    REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
     298
     299
     300    ! Local variables
     301    !****************************************************************************************
     302    INTEGER :: i, j
     303    INTEGER, DIMENSION(1) :: iloc
     304    LOGICAL :: check = .FALSE.
     305    REAL, PARAMETER :: t_grnd = 271.35
     306    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
     307    REAL, DIMENSION(klon) :: tsurf_cpl, fder_new
     308    REAL, DIMENSION(klon) :: alb_cpl
     309    REAL, DIMENSION(klon) :: u0, v0
     310    REAL, DIMENSION(klon) :: u1_lay, v1_lay
     311    REAL sens_prec_liq(knon), sens_prec_sol(knon)
     312    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
     313
     314    ! End definitions
     315    !****************************************************************************************
     316
     317    IF (check) WRITE(*, *)'Entering surface_seaice, knon=', knon
    318318
    319319    lat_prec_liq = 0.; lat_prec_sol = 0.
    320320
    321 !****************************************************************************************
    322 ! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
    323 
    324 !****************************************************************************************
     321    !****************************************************************************************
     322    ! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
     323
     324    !****************************************************************************************
    325325
    326326    CALL cpl_receive_seaice_fields(knon, knindex, &
    327          tsurf_cpl, alb_cpl, u0, v0)
     327            tsurf_cpl, alb_cpl, u0, v0)
    328328
    329329    alb1_new(1:knon) = alb_cpl(1:knon)
    330     alb2_new(1:knon) = alb_cpl(1:knon)   
    331 
    332    
    333 !****************************************************************************************
    334 ! Calculate fluxes at surface
    335 
    336 !****************************************************************************************
     330    alb2_new(1:knon) = alb_cpl(1:knon)
     331
     332
     333    !****************************************************************************************
     334    ! Calculate fluxes at surface
     335
     336    !****************************************************************************************
    337337    cal = 0.
    338338    dif_grnd = 0.
    339339    beta = 1.0
    340    
     340
    341341    DO i = 1, knon
    342        u1_lay(i) = u1(i) - u0(i)
    343        v1_lay(i) = v1(i) - v0(i)
     342      u1_lay(i) = u1(i) - u0(i)
     343      v1_lay(i) = v1(i) - v0(i)
    344344    END DO
    345345
    346346    CALL calcul_fluxs(knon, is_sic, dtime, &
    347          tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
    348          precip_rain, precip_snow, snow, qsurf, &
    349          radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
    350          f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
    351          tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
    352          sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
     347            tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
     348            precip_rain, precip_snow, snow, qsurf, &
     349            radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
     350            f_qsat_oce, AcoefH, AcoefQ, BcoefH, BcoefQ, &
     351            tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
     352            sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
    353353    do j = 1, knon
    354354      i = knindex(j)
    355       sens_prec_liq_o(i,2) = sens_prec_liq(j)
    356       sens_prec_sol_o(i,2) = sens_prec_sol(j)
    357       lat_prec_liq_o(i,2) = lat_prec_liq(j)
    358       lat_prec_sol_o(i,2) = lat_prec_sol(j)
     355      sens_prec_liq_o(i, 2) = sens_prec_liq(j)
     356      sens_prec_sol_o(i, 2) = sens_prec_sol(j)
     357      lat_prec_liq_o(i, 2) = lat_prec_liq(j)
     358      lat_prec_sol_o(i, 2) = lat_prec_sol(j)
    359359    enddo
    360360
    361361
    362 ! - Flux calculation at first modele level for U and V
     362    ! - Flux calculation at first modele level for U and V
    363363    CALL calcul_flux_wind(knon, dtime, &
    364          u0, v0, u1, v1, gustiness, cdragm, &
    365          AcoefU, AcoefV, BcoefU, BcoefV, &
    366          p1lay, temp_air, &
    367          flux_u1, flux_v1) 
    368 
    369 !****************************************************************************************
    370 ! Calculate fder : flux derivative (sensible and latente)
    371 
    372 !****************************************************************************************
     364            u0, v0, u1, v1, gustiness, cdragm, &
     365            AcoefU, AcoefV, BcoefU, BcoefV, &
     366            p1lay, temp_air, &
     367            flux_u1, flux_v1)
     368
     369    !****************************************************************************************
     370    ! Calculate fder : flux derivative (sensible and latente)
     371
     372    !****************************************************************************************
    373373    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
    374    
     374
    375375    iloc = MAXLOC(fder_new(1:klon))
    376376    IF (check .AND. fder_new(iloc(1))> 0.) THEN
    377        WRITE(*,*)'**** Debug fder ****'
    378        WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
    379        WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
    380             dflux_s(iloc(1)), dflux_l(iloc(1))
     377      WRITE(*, *)'**** Debug fder ****'
     378      WRITE(*, *)'max fder(', iloc(1), ') = ', fder_new(iloc(1))
     379      WRITE(*, *)'fder_old, dflux_s, dflux_l', fder_old(iloc(1)), &
     380              dflux_s(iloc(1)), dflux_l(iloc(1))
    381381    ENDIF
    382382
    383 !****************************************************************************************
    384 ! Send and cumulate fields to the coupler
    385 
    386 !****************************************************************************************
     383    !****************************************************************************************
     384    ! Send and cumulate fields to the coupler
     385
     386    !****************************************************************************************
    387387
    388388    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
    389        pctsrf, lafin, rlon, rlat, &
    390        swnet, lwnet, fluxlat, fluxsens, &
    391        precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
    392        sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
    393 
    394  
     389            pctsrf, lafin, rlon, rlat, &
     390            swnet, lwnet, fluxlat, fluxsens, &
     391            precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, &
     392            sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
    395393
    396394  END SUBROUTINE ocean_cpl_ice
    397395
    398 !****************************************************************************************
     396  !****************************************************************************************
    399397
    400398END MODULE ocean_cpl_mod
Note: See TracChangeset for help on using the changeset viewer.