Ignore:
Timestamp:
Sep 25, 2018, 5:22:13 PM (6 years ago)
Author:
lguez
Message:

Indent file.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phylmd/surf_ocean_mod.F90

    r3389 r3395  
    77
    88CONTAINS
    9 !
    10 !******************************************************************************
    11 !
     9  !
     10  !******************************************************************************
     11  !
    1212  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
    1313       windsp, rmu0, fder, tsurf_in, &
     
    2222       flux_u1, flux_v1)
    2323
    24   use albedo, only: alboc, alboc_cd
    25   USE dimphy, ONLY: klon, zmasq
    26   USE surface_data, ONLY     : type_ocean
    27   USE ocean_forced_mod, ONLY : ocean_forced_noice
    28   USE ocean_slab_mod, ONLY   : ocean_slab_noice
    29   USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
    30   USE indice_sol_mod, ONLY : nbsrf, is_oce
    31   USE limit_read_mod
    32 !
    33 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
    34 ! slab or couple). The calculations of albedo and rugosity for the ocean surface are
    35 ! done in here because they are identical for the different modes of ocean.
     24    use albedo, only: alboc, alboc_cd
     25    USE dimphy, ONLY: klon, zmasq
     26    USE surface_data, ONLY     : type_ocean
     27    USE ocean_forced_mod, ONLY : ocean_forced_noice
     28    USE ocean_slab_mod, ONLY   : ocean_slab_noice
     29    USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
     30    USE indice_sol_mod, ONLY : nbsrf, is_oce
     31    USE limit_read_mod
     32    !
     33    ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
     34    ! slab or couple). The calculations of albedo and rugosity for the ocean surface are
     35    ! done in here because they are identical for the different modes of ocean.
    3636
    3737
     
    4141    ! for cycle_diurne and for iflag_z0_oce==-1 (prescribed z0)
    4242
    43 ! Input variables
    44 !******************************************************************************
     43    ! Input variables
     44    !******************************************************************************
    4545    INTEGER, INTENT(IN)                      :: itime, jour, knon
    4646    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
     
    6666    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
    6767
    68 ! In/Output variables
    69 !******************************************************************************
     68    ! In/Output variables
     69    !******************************************************************************
    7070    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
    7171    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
     
    7373    REAL, DIMENSION(klon), INTENT(inOUT):: z0h
    7474
    75 ! Output variables
    76 !******************************************************************************
     75    ! Output variables
     76    !******************************************************************************
    7777    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m
    78 !albedo SB >>>
    79 !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    80 !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
     78    !albedo SB >>>
     79    !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
     80    !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
    8181    REAL, DIMENSION(6), INTENT(IN)          :: SFRWL
    8282    REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
    83 !albedo SB <<<     
     83    !albedo SB <<<     
    8484    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    8585    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
     
    8888    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
    8989
    90 ! Local variables
    91 !******************************************************************************
     90    ! Local variables
     91    !******************************************************************************
    9292    INTEGER               :: i, k
    9393    REAL                  :: tmp
     
    9898    CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
    9999
    100 ! End definition
    101 !******************************************************************************
    102 
    103 
    104 !******************************************************************************
    105 ! Calculate total net radiance at surface
    106 !
    107 !******************************************************************************
     100    ! End definition
     101    !******************************************************************************
     102
     103
     104    !******************************************************************************
     105    ! Calculate total net radiance at surface
     106    !
     107    !******************************************************************************
    108108    radsol(1:klon) = 0.0 ! initialisation a priori inutile
    109109    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
    110110
    111 !******************************************************************************
    112 ! Cdragq computed from cdrag
    113 ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
    114 ! it can be computed inside surf_ocean
    115 ! More complicated appraches may require the propagation through
    116 ! pbl_surface of an independant cdragq variable.
    117 !******************************************************************************
     111    !******************************************************************************
     112    ! Cdragq computed from cdrag
     113    ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
     114    ! it can be computed inside surf_ocean
     115    ! More complicated appraches may require the propagation through
     116    ! pbl_surface of an independant cdragq variable.
     117    !******************************************************************************
    118118
    119119    IF ( f_z0qh_oce .ne. 1.) THEN
    120 ! Si on suit les formulations par exemple de Tessel, on
    121 ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
     120       ! Si on suit les formulations par exemple de Tessel, on
     121       ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
    122122       cdragq(1:knon)=cdragh(1:knon)*                                      &
    123        log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))
     123            log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))
    124124    ELSE
    125125       cdragq(1:knon)=cdragh(1:knon)
     
    127127
    128128
    129 !******************************************************************************
    130 ! Switch according to type of ocean (couple, slab or forced)
    131 !******************************************************************************
     129    !******************************************************************************
     130    ! Switch according to type of ocean (couple, slab or forced)
     131    !******************************************************************************
    132132    SELECT CASE(type_ocean)
    133133    CASE('couple')
     
    154154            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    155155            tsurf_new, dflux_s, dflux_l, lmt_bils)
    156        
     156
    157157    CASE('force')
    158158       CALL ocean_forced_noice( &
     
    168168    END SELECT
    169169
    170 !******************************************************************************
    171 ! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
    172 !******************************************************************************
     170    !******************************************************************************
     171    ! fcodron: compute lmt_bils  forced case (same as wfbils_oce / 1.-contfracatm)
     172    !******************************************************************************
    173173    IF (type_ocean.NE.'slab') THEN
    174         lmt_bils(1:klon)=0.
    175         DO i=1,knon
    176            lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
    177            *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
    178         END DO
     174       lmt_bils(1:klon)=0.
     175       DO i=1,knon
     176          lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
     177               *pctsrf(knindex(i),is_oce)/(1.-zmasq(knindex(i)))
     178       END DO
    179179    END IF
    180180
    181 !******************************************************************************
    182 ! Calculate ocean surface albedo
    183 !******************************************************************************
    184 !albedo SB >>>
    185 IF (iflag_albedo==0) THEN
    186 !--old parametrizations of ocean surface albedo
    187 !
    188     IF (iflag_cycle_diurne.GE.1) THEN
    189 !
    190        CALL alboc_cd(rmu0,alb_eau)
    191 !
    192 !--ad-hoc correction for model radiative balance tuning
    193 !--now outside alboc_cd routine
    194        alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
    195        alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0)
    196 !
     181    !******************************************************************************
     182    ! Calculate ocean surface albedo
     183    !******************************************************************************
     184    !albedo SB >>>
     185    IF (iflag_albedo==0) THEN
     186       !--old parametrizations of ocean surface albedo
     187       !
     188       IF (iflag_cycle_diurne.GE.1) THEN
     189          !
     190          CALL alboc_cd(rmu0,alb_eau)
     191          !
     192          !--ad-hoc correction for model radiative balance tuning
     193          !--now outside alboc_cd routine
     194          alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
     195          alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0)
     196          !
     197       ELSE
     198          !
     199          CALL alboc(REAL(jour),rlat,alb_eau)
     200          !--ad-hoc correction for model radiative balance tuning
     201          !--now outside alboc routine
     202          alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
     203          alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60)
     204          !
     205       ENDIF
     206       !
     207       DO i =1, knon
     208          DO  k=1,nsw
     209             alb_dir_new(i,k) = alb_eau(knindex(i))
     210          ENDDO
     211       ENDDO
     212       !IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions
     213       !albedo for diffuse radiation is taken the same as for direct radiation
     214       alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:)
     215       !IM 09122015 end
     216       !
     217    ELSE IF (iflag_albedo==1) THEN
     218       !--new parametrization of ocean surface albedo by Sunghye Baek
     219       !--albedo for direct and diffuse radiation are different
     220       !
     221       CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
     222       !
     223       !--ad-hoc correction for model radiative balance tuning
     224       alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic
     225       alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic
     226       alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0)
     227       alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0)
     228       !
     229    ELSE IF (iflag_albedo==2) THEN
     230       ! F. Codron albedo read from limit.nc
     231       CALL limit_read_rug_alb(itime, dtime, jour,&
     232            knon, knindex, z0_lim, alb_eau)
     233       DO i =1, knon
     234          DO  k=1,nsw
     235             alb_dir_new(i,k) = alb_eau(i)
     236          ENDDO
     237       ENDDO
     238       alb_dif_new=alb_dir_new
     239    ENDIF
     240    !albedo SB <<<
     241
     242    !******************************************************************************
     243    ! Calculate the rugosity
     244    !******************************************************************************
     245    IF (iflag_z0_oce==0) THEN
     246       DO i = 1, knon
     247          tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
     248          z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
     249               +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
     250          z0m(i) = MAX(1.5e-05,z0m(i))
     251       ENDDO
     252       z0h(1:knon)=z0m(1:knon) ! En attendant mieux
     253
     254    ELSE IF (iflag_z0_oce==1) THEN
     255       DO i = 1, knon
     256          tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
     257          z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
     258               + 0.11*14e-6 / SQRT(cdragm(i) * tmp)
     259          z0m(i) = MAX(1.5e-05,z0m(i))
     260          z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp)
     261       ENDDO
     262    ELSE IF (iflag_z0_oce==-1) THEN
     263       DO i = 1, knon
     264          z0m(i) = z0min
     265          z0h(i) = z0min
     266       ENDDO
    197267    ELSE
    198 !
    199        CALL alboc(REAL(jour),rlat,alb_eau)
    200 !--ad-hoc correction for model radiative balance tuning
    201 !--now outside alboc routine
    202        alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
    203        alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60)
    204 !
     268       CALL abort_physic(modname,'version non prevue',1)
    205269    ENDIF
    206 !
    207     DO i =1, knon
    208       DO  k=1,nsw
    209        alb_dir_new(i,k) = alb_eau(knindex(i))
    210       ENDDO
    211     ENDDO
    212 !IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions
    213 !albedo for diffuse radiation is taken the same as for direct radiation
    214      alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:)
    215 !IM 09122015 end
    216 !
    217 ELSE IF (iflag_albedo==1) THEN
    218 !--new parametrization of ocean surface albedo by Sunghye Baek
    219 !--albedo for direct and diffuse radiation are different
    220 !
    221     CALL ocean_albedo(knon,rmu0,knindex,windsp,SFRWL,alb_dir_new,alb_dif_new)
    222 !
    223 !--ad-hoc correction for model radiative balance tuning
    224     alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic
    225     alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic
    226     alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0)
    227     alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0)
    228 !
    229 ! F. Codron albedo read from limit.nc
    230 ELSE IF (iflag_albedo==2) THEN
    231     CALL limit_read_rug_alb(itime, dtime, jour,&
    232          knon, knindex, z0_lim, alb_eau)
    233     DO i =1, knon
    234       DO  k=1,nsw
    235        alb_dir_new(i,k) = alb_eau(i)
    236       ENDDO
    237     ENDDO
    238     alb_dif_new=alb_dir_new
    239 ENDIF
    240 !albedo SB <<<
    241 
    242 !******************************************************************************
    243 ! Calculate the rugosity
    244 !******************************************************************************
    245 IF (iflag_z0_oce==0) THEN
    246     DO i = 1, knon
    247        tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
    248        z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
    249             +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
    250        z0m(i) = MAX(1.5e-05,z0m(i))
    251     ENDDO   
    252     z0h(1:knon)=z0m(1:knon) ! En attendant mieux
    253 
    254 ELSE IF (iflag_z0_oce==1) THEN
    255     DO i = 1, knon
    256        tmp = MAX(cepdu2,gustiness(i)+u1(i)**2+v1(i)**2)
    257        z0m(i) = 0.018*cdragm(i) * (gustiness(i)+u1(i)**2+v1(i)**2)/RG  &
    258             + 0.11*14e-6 / SQRT(cdragm(i) * tmp)
    259        z0m(i) = MAX(1.5e-05,z0m(i))
    260        z0h(i)=0.4*14e-6 / SQRT(cdragm(i) * tmp)
    261     ENDDO
    262 ELSE IF (iflag_z0_oce==-1) THEN
    263     DO i = 1, knon
    264        z0m(i) = z0min
    265        z0h(i) = z0min
    266     ENDDO
    267 ELSE
    268        CALL abort_physic(modname,'version non prevue',1)
    269 ENDIF
    270 !
    271 !******************************************************************************
     270    !
     271    !******************************************************************************
    272272  END SUBROUTINE surf_ocean
    273 !******************************************************************************
    274 !
     273  !******************************************************************************
     274  !
    275275END MODULE surf_ocean_mod
Note: See TracChangeset for help on using the changeset viewer.