New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11403 for NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF – NEMO

Ignore:
Timestamp:
2019-08-05T19:14:52+02:00 (5 years ago)
Author:
mathiot
Message:

ENHANCE-02_ISF_nemo : add comments, renaming file (AGRIF), add isfload module (ticket #2142)

Location:
NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF
Files:
1 added
8 edited
4 moved

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isf.F90

    r11395 r11403  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   isfmlt       : compute iceshelf melt and heat flux 
     13   !!   isf          : define and allocate ice shelf variables 
    1414   !!---------------------------------------------------------------------- 
    1515 
    … …  
    3232   REAL(wp), PUBLIC ::   rn_gammas0                  !: salinity    exchange coeficient    [] 
    3333   REAL(wp), PUBLIC ::   rn_htbl                     !: Losch top boundary layer thickness [m] 
     34   CHARACTER(LEN=256), PUBLIC :: cn_isfload          !: ice shelf load computation method 
    3435   CHARACTER(LEN=256), PUBLIC :: cn_gammablk         !: gamma formulation 
    3536   CHARACTER(LEN=256), PUBLIC :: cn_isfcav_mlt, cn_isfpar_mlt !: melt formulation (cavity/param) 
    … …  
    4748   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mskisf_par, mskisf_cav   !: Level of ice shelf base 
    4849   ! 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf_tbl, rhisf_tbl_0   !: thickness of tbl  [m] 
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf_tbl_cav, rhisf_tbl_par !: thickness of tbl  [m] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   risfload                     !: ice shelf load 
     51   ! 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf_tbl_0                  !: thickness of tbl (initial value)  [m] 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf_tbl_cav, rhisf_tbl_par !: thickness of tbl                  [m] 
    5154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rfrac_tbl_cav, rfrac_tbl_par !: fraction of the deepest cell affect by isf tbl  [] 
    5255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rhisf0_tbl_par 
    5356   ! 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_cpl 
    5458   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_par, fwfisf_par_b !: net fwf from the ice shelf        [kg/m2/s] 
    5559   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fwfisf_cav, fwfisf_cav_b !: net fwf from the ice shelf        [kg/m2/s] 
    5660   ! 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   risfdep                  !: Iceshelf draft                              (ISF) 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   bathy                    !: Bathymetry (needed for isf tbl definition)  (ISF) 
    5961   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   risfLeff 
    6062   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   risf_cav_tsc_b, risf_cav_tsc     !: before and now T & S isf contents [K.m/s & PSU.m/s]   
    … …  
    9193   SUBROUTINE isf_alloc_par() 
    9294      !!--------------------------------------------------------------------- 
    93       !!                  ***  ROUTINE isfmlt_alloc  *** 
     95      !!                  ***  ROUTINE isf_alloc_par  *** 
    9496      !! 
    9597      !! ** Purpose :  
    … …  
    105107      ierr = ierr + ialloc 
    106108      ! 
     109      ALLOCATE(misfkt_par(jpi,jpj), misfkb_par(jpi,jpj), STAT=ialloc ) 
     110      ierr = ierr + ialloc 
     111      ! 
     112      ALLOCATE( rfrac_tbl_par(jpi,jpj), STAT=ialloc) 
     113      ierr = ierr + ialloc 
     114      ! 
     115      ALLOCATE( rhisf_tbl_par(jpi,jpj), rhisf0_tbl_par(jpi,jpj), STAT=ialloc) 
     116      ierr = ierr + ialloc 
     117      ! 
     118      ALLOCATE( mskisf_par(jpi,jpj), STAT=ialloc) 
     119      ierr = ierr + ialloc 
     120      ! 
    107121      CALL mpp_sum ( 'isf', ierr ) 
    108122      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' ) 
    … …  
    111125   SUBROUTINE isf_alloc_cav() 
    112126      !!--------------------------------------------------------------------- 
    113       !!                  ***  ROUTINE isfmlt_alloc  *** 
     127      !!                  ***  ROUTINE isf_alloc_cav  *** 
    114128      !! 
    115129      !! ** Purpose :  
    … …  
    122136      ierr = 0       ! set to zero if no array to be allocated 
    123137      ! 
     138      ALLOCATE(misfkt_cav(jpi,jpj), misfkb_cav(jpi,jpj), STAT=ialloc ) 
     139      ierr = ierr + ialloc 
     140      ! 
     141      ALLOCATE( rfrac_tbl_cav(jpi,jpj), STAT=ialloc) 
     142      ierr = ierr + ialloc 
     143      ! 
     144      ALLOCATE( rhisf_tbl_cav(jpi,jpj), STAT=ialloc) 
     145      ierr = ierr + ialloc 
     146      ! 
     147      ALLOCATE( mskisf_cav(jpi,jpj), STAT=ialloc) 
     148      ierr = ierr + ialloc 
     149      ! 
    124150      CALL mpp_sum ( 'isf', ierr ) 
    125151      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'isf: failed to allocate arrays.' ) 
    … …  
    128154   SUBROUTINE isf_alloc() 
    129155      !!--------------------------------------------------------------------- 
    130       !!                  ***  ROUTINE isfmlt_alloc  *** 
     156      !!                  ***  ROUTINE isf_alloc  *** 
    131157      !! 
    132158      !! ** Purpose :  
    … …  
    140166      ierr = 0       ! set to zero if no array to be allocated 
    141167      ! 
    142       ALLOCATE(misfkt_par(jpi,jpj), misfkb_par(jpi,jpj),             & 
    143          &     misfkt_cav(jpi,jpj), misfkb_cav(jpi,jpj), STAT=ialloc ) 
     168      ALLOCATE(fwfisf_par(jpi,jpj), fwfisf_par_b(jpi,jpj), & 
     169         &     fwfisf_cav(jpi,jpj), fwfisf_cav_b(jpi,jpj), & 
     170         &     fwfisf_cpl(jpi,jpj),            STAT=ialloc ) 
    144171      ierr = ierr + ialloc 
    145172      ! 
    146       ALLOCATE(fwfisf_par(jpi,jpj), fwfisf_par_b(jpi,jpj),             & 
    147          &     fwfisf_cav(jpi,jpj), fwfisf_cav_b(jpi,jpj), STAT=ialloc ) 
     173      ALLOCATE(risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc ) 
    148174      ierr = ierr + ialloc 
    149175      ! 
    150       ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts),             & 
    151          &     risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc ) 
     176      ALLOCATE(risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc ) 
    152177      ierr = ierr + ialloc 
    153178      ! 
    154       ALLOCATE( rfrac_tbl_cav(jpi,jpj), rfrac_tbl_par(jpi,jpj), STAT=ialloc) 
    155       ierr = ierr + ialloc 
    156       ! 
    157       ALLOCATE( rhisf_tbl_par(jpi,jpj), rhisf_tbl_cav(jpi,jpj), STAT=ialloc) 
    158       ierr = ierr + ialloc 
    159       ! 
    160       ALLOCATE( mskisf_cav(jpi,jpj), mskisf_par(jpi,jpj), STAT=ialloc) 
    161       ierr = ierr + ialloc 
    162       ! 
    163       ALLOCATE(risfdep(jpi,jpj), bathy(jpi,jpj), STAT=ialloc) 
     179      ALLOCATE(risfload(jpi,jpj), STAT=ialloc) 
    164180      ierr = ierr + ialloc 
    165181      ! 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfcav.F90

    r11395 r11403  
    156156      ! allocation isfcav gamtisf, gamsisf,  
    157157      CALL isf_alloc_cav() 
    158  
    159       ! initialisation 
    160       mskisf_cav(:,:) = (1._wp - tmask(:,:,1)) * ssmask(:,:) 
    161158      ! 
    162       misfkt_cav(:,:) = mikt(:,:) 
     159      ! cav 
     160      misfkt_cav(:,:)     = mikt(:,:) ; misfkb_cav(:,:)       = 1 
     161      rhisf_tbl_cav(:,:)  = 0.0_wp    ; rfrac_tbl_cav(:,:)    = 0.0_wp 
    163162      ! 
    164163      SELECT CASE ( TRIM(cn_isfcav_mlt) ) 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfcavmlt.F90

    r11395 r11403  
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers 
    14    USE isf 
    15    USE isfdiags 
     14   USE isf            ! ice shelf public variables 
    1615   USE dom_oce        ! ocean space and time domain 
    1716   USE phycst         ! physical constants 
    1817   USE eosbn2         ! equation of state 
    19    USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    2018   ! 
    2119   USE in_out_manager ! I/O manager 
    2220   USE iom            ! I/O library 
    2321   USE fldread        ! read input field at current time step 
    24    USE lbclnk         ! 
     22   USE lib_fortran 
    2523 
    2624   IMPLICIT NONE 
    … …  
    4038! ------------------------------------------------------------------------------------------------------- 
    4139 
    42    SUBROUTINE isfcav_mlt(kt, pgt, pgs , pttbl, pstbl,   & 
    43       &                           pqhc, pqoce, pqfwf    ) 
    44       !!---------------------------------------------------------------------- 
    45       !! ** Purpose    :  
    46       !! 
    47       !! ** Method     :  
    48       !!--------------------------------------------------------------------- 
    49       !!-------------------------- OUT ------------------------------------- 
    50       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqoce, pqfwf  ! heat and fwf fluxes 
     40   SUBROUTINE isfcav_mlt(kt, pgt, pgs , pttbl, pstbl, & 
     41      &                           pqhc, pqoce, pqfwf  ) 
     42      !!---------------------------------------------------------------------- 
     43      !! 
     44      !! ** Purpose    : compute ice shelf fwf/heqt fluxes  
     45      !! 
     46      !!--------------------------------------------------------------------- 
     47      !!-------------------------- OUT ------------------------------------- 
     48      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat and fwf fluxes 
    5149      !!-------------------------- IN  ------------------------------------- 
    5250      INTEGER, INTENT(in) :: kt 
    … …  
    5957      SELECT CASE ( cn_isfcav_mlt ) 
    6058      CASE ( 'spe' )   ! ice shelf melt specified (read input file, and heat fluxes derived from 
    61          CALL isfmlt_spe( kt, pstbl,                  & 
    62             &                  pqhc, pqoce, pqfwf    ) 
     59         CALL isfmlt_spe( kt, pstbl,               & 
     60            &                  pqhc, pqoce, pqfwf  ) 
    6361      CASE ( '2eq' )   !  ISOMIP  formulation (2 equations) for volume flux (Hunter et al., 2006) 
    64          CALL isfmlt_2eq( pgt, pttbl, pstbl,          & 
    65             &                  pqhc , pqoce, pqfwf    ) 
     62         CALL isfmlt_2eq( pgt, pttbl, pstbl,       & 
     63            &                  pqhc , pqoce, pqfwf ) 
    6664      CASE ( '3eq' )   ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015) 
    67          CALL isfmlt_3eq( pgt, pgs , pttbl, pstbl,   & 
    68             &                  pqhc, pqoce, pqfwf    ) 
     65         CALL isfmlt_3eq( pgt, pgs , pttbl, pstbl, & 
     66            &                  pqhc, pqoce, pqfwf  ) 
    6967      CASE ( 'oasis' ) ! fwf pass trough oasis 
    70          !CALL isfmlt_oasis( kt, pstbl,               & 
    71          !   &                    zqhc, zqoce, pqfwf  ) 
     68         CALL isfmlt_oasis( kt, pstbl,              & 
     69            &                   pqhc, pqoce, pqfwf  ) 
    7270      CASE DEFAULT 
    7371         CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfcav (should not see this)') 
    … …  
    8078! ------------------------------------------------------------------------------------------------------- 
    8179 
    82    SUBROUTINE isfmlt_spe(kt, pstbl,                  &  ! <<== in 
    83       &                       pqhc, pqoce, pqfwf    )  ! ==>> out 
    84       !!---------------------------------------------------------------------- 
    85       !! ** Purpose    :  
    86       !! 
    87       !! ** Method     :  
    88       !!--------------------------------------------------------------------- 
    89       !!-------------------------- OUT ------------------------------------- 
    90       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes 
    91       !!-------------------------- IN  ------------------------------------- 
    92       INTEGER                     , INTENT(in   ) :: kt 
    93       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pstbl         ! salinity in top boundary layer 
    94       !!-------------------------------------------------------------------- 
    95       REAL(wp), DIMENSION(jpi,jpj) :: ztfrz         ! freezing temperature 
     80   SUBROUTINE isfmlt_spe(kt, pstbl,              &  ! <<== in 
     81      &                      pqhc , pqoce, pqfwf )  ! ==>> out 
     82      !!---------------------------------------------------------------------- 
     83      !! ** Purpose    : - read ice shelf melt from forcing file 
     84      !!                 - compute ocea-ice heat flux (assuming it is equal to latent heat) 
     85      !!                 - compute heat content flux 
     86      !!--------------------------------------------------------------------- 
     87      !!-------------------------- OUT ------------------------------------- 
     88      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes 
     89      !!-------------------------- IN  ------------------------------------- 
     90      INTEGER                     , INTENT(in   ) :: kt                  ! current time step 
     91      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pstbl               ! salinity in tbl 
     92      !!-------------------------------------------------------------------- 
     93      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz                              ! tbl freezing temperature 
    9694      !!-------------------------------------------------------------------- 
    9795      ! 
    … …  
    103101      ! 
    104102      ! define fwf and qoce 
    105       pqfwf(:,:) = -sf_isfcav_fwf(1)%fnow(:,:,1)            ! fwf 
    106103      ! ocean heat flux is assume to be equal to the latent heat 
    107       pqoce(:,:) =  pqfwf(:,:) * rLfusisf             ! ocean heat flux 
    108       pqhc (:,:) =  pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux 
     104      pqfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1)      ! fwf                ( >0 out) 
     105      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out) 
     106      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out) 
    109107      ! 
    110108   END SUBROUTINE isfmlt_spe 
    111109 
    112    SUBROUTINE isfmlt_2eq(pgt, pttbl, pstbl,          &  ! <<== in 
    113       &                       pqhc , pqoce, pqfwf    )  ! ==>> out 
    114       !!---------------------------------------------------------------------- 
    115       !! ** Purpose    :  
    116       !! 
    117       !! ** Method     :  
    118       !!--------------------------------------------------------------------- 
    119       !!-------------------------- OUT ------------------------------------- 
    120       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqoce, pqfwf  ! hean content, ocean-ice heat and fwf fluxes 
     110   SUBROUTINE isfmlt_2eq(pgt, pttbl, pstbl,       &  ! <<== in 
     111      &                       pqhc , pqoce, pqfwf )  ! ==>> out 
     112      !!---------------------------------------------------------------------- 
     113      !! ** Purpose    : Compute ice shelf fwf/heqt fluxes using ISOMIP formulation (Hunter et al., 2006) 
     114      !! 
     115      !! ** Method     : The ice shelf melt latent heat is defined as being equal to the ocean/ice heat flux. 
     116      !!                 From this we can derived the fwf, ocean/ice heat flux and the heat content flux as being : 
     117      !!                   qfwf  = Gammat * Rau0 * Cp * ( Tw - Tfrz ) / Lf  
     118      !!                   qhoce = qlat 
     119      !!                   qhc   = qfwf * Cp * Tfrz 
     120      !! 
     121      !! ** Reference  : Hunter,  J.  R.:  Specification  for  test  models  of  ice  shelf  cavities,   
     122      !!                 Tech.  Rep.  June,  Antarctic  Climate  &  Ecosystems  Cooperative  Research  Centre,  available  at:   
     123      !!                 http://staff.acecrc.org.au/~bkgalton/ISOMIP/test_cavities.pdf (last access: 21 July 2016), 2006. 
     124      !!--------------------------------------------------------------------- 
     125      !!-------------------------- OUT ------------------------------------- 
     126      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! hean content, ocean-ice heat and fwf fluxes 
    121127      !!-------------------------- IN  ------------------------------------- 
    122128      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt           ! temperature exchange coeficient 
    … …  
    124130      !!-------------------------------------------------------------------- 
    125131      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz         ! freezing temperature 
     132      REAL(wp), DIMENSION(jpi,jpj) :: zthd          ! thermal driving 
    126133      !!-------------------------------------------------------------------- 
    127134      ! 
    … …  
    129136      CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) ) 
    130137      ! 
     138      ! thermal driving 
     139      zthd (:,:) = pttbl(:,:) - ztfrz(:,:) 
     140      ! 
    131141      ! compute ocean-ice heat flux and then derive fwf assuming that ocean heat flux equal latent heat 
    132       pqfwf(:,:) = - pgt(:,:) * rau0_rcp * ( pttbl(:,:)-ztfrz(:,:) ) * r1_Lfusisf  ! fresh water flux ( > 0 out ) 
    133       pqoce(:,:) = - pqfwf(:,:) * rLfusisf                                         ! ocea-ice flux (assume to be equal to latent heat flux) ( > 0 out ) 
    134       pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp                                 ! heat content flux ( > 0 out ) 
     142      pqfwf(:,:) = - pgt(:,:) * rau0_rcp * zthd(:,:) * r1_Lfusisf  ! fresh water flux ( > 0 out ) 
     143      pqoce(:,:) = - pqfwf(:,:) * rLfusisf                         ! ocea-ice flux    ( > 0 out ) 
     144      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp                 ! heat content flux ( > 0 out ) 
    135145      ! 
    136146      ! output thermal driving 
    137       CALL iom_put('isfthermald_cav',( pttbl(:,:)-ztfrz(:,:) )) 
     147      CALL iom_put('isfthermald_cav', zthd ) 
    138148      ! 
    139149   END SUBROUTINE isfmlt_2eq 
    140150 
    141    SUBROUTINE isfmlt_3eq(pgt, pgs , pttbl, pstbl,   & 
    142       &                       pqhc, pqoce, pqfwf    ) 
    143       !!---------------------------------------------------------------------- 
    144       !! ** Purpose    :  
    145       !! 
    146       !! ** Method     :  
    147       !!--------------------------------------------------------------------- 
    148       !!-------------------------- OUT ------------------------------------- 
    149       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqoce, pqfwf  ! latent heat and fwf fluxes 
    150       !!-------------------------- IN  ------------------------------------- 
    151       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt  , pgs    ! temperature exchange coeficient 
    152       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl  ! temperature and salinity in top boundary layer 
    153       !!-------------------------------------------------------------------- 
    154       REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7 
    155       REAL(wp) :: zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac 
     151   SUBROUTINE isfmlt_3eq(pgt, pgs , pttbl, pstbl, & 
     152      &                       pqhc, pqoce, pqfwf  ) 
     153      !!---------------------------------------------------------------------- 
     154      !! ** Purpose    : Compute ice shelf fwf/heqt fluxes using the 3 equation formulation  
     155      !! 
     156      !! ** Method     : The melt rate is determined considering the heat balance, the salt balance 
     157      !!                 at the phase change interface and a linearisation of the equation of state. 
     158      !! 
     159      !! ** Reference  : - Holland, D. M. and Jenkins, A., 
     160      !!                   Modeling Thermodynamic Ice-Ocean Interactions at the Base of an Ice Shelf, 
     161      !!                   J. Phys. Oceanogr., 29, 1999. 
     162      !!                 - Asay-Davis, X. S., Cornford, S. L., Durand, G., Galton-Fenzi, B. K., Gladstone,  
     163      !!                   R. M., Gudmundsson, G. H., Hattermann, T., Holland, D. M., Holland, D., Holland,  
     164      !!                   P. R., Martin, D. F., Mathiot, P., Pattyn, F., and Seroussi, H.: 
     165      !!                   Experimental design for three interrelated marine ice sheet and ocean model intercomparison projects:  
     166      !!                   MISMIP v. 3 (MISMIP +), ISOMIP v. 2 (ISOMIP +) and MISOMIP v. 1 (MISOMIP1),  
     167      !!                   Geosci. Model Dev., 9, 2471-2497, https://doi.org/10.5194/gmd-9-2471-2016, 2016.  
     168      !!--------------------------------------------------------------------- 
     169      !!-------------------------- OUT ------------------------------------- 
     170      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! latent heat and fwf fluxes 
     171      !!-------------------------- IN  ------------------------------------- 
     172      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pgt  , pgs          ! heat/salt exchange coeficient 
     173      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl        ! mean temperature and salinity in top boundary layer 
     174      !!-------------------------------------------------------------------- 
     175      REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7       ! dummy local scalar for quadratic equation resolution 
     176      REAL(wp) :: zaqe,zbqe,zcqe,zaqer,zdis,zsfrz,zcfac     ! dummy local scalar for quadratic equation resolution 
    156177      REAL(wp) :: zeps = 1.e-20 
    157       REAL(wp), DIMENSION(jpi,jpj) :: ztfrz             ! freezing point 
    158       REAL(wp), DIMENSION(jpi,jpj) :: zqcon             ! conductive flux through the ice shelf 
     178      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz         ! freezing point 
     179      REAL(wp), DIMENSION(jpi,jpj) :: zqcon         ! conductive flux through the ice shelf 
     180      REAL(wp), DIMENSION(jpi,jpj) :: zthd          ! thermal driving 
    159181      ! 
    160182      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    162184      ! 
    163185      ! compute upward heat flux zhtflx and upward water flux zwflx 
    164       ! Resolution of a 2d equation from equation 24, 25 and 26 
     186      ! Resolution of a 3d equation from equation 24, 25 and 26 (note conduction through the ice has been added to Eq 24) 
    165187      DO jj = 1, jpj 
    166188         DO ji = 1, jpi 
    … …  
    188210            ztfrz(ji,jj) = zeps4 + risf_lamb1 * zsfrz 
    189211            ! 
     212            ! thermal driving 
     213            zthd(ji,jj) = pttbl(ji,jj) - ztfrz(ji,jj) 
     214            ! 
    190215            ! compute the upward water and heat flux (eq. 24 and eq. 26) 
    191             ! ocean heat content flux added later on. 
    192             pqfwf(ji,jj) = rau0 * pgs(ji,jj) * ( zsfrz - pstbl(ji,jj) ) / MAX(zsfrz,zeps) ! fresh water flux (> 0 out) 
    193             pqoce(ji,jj) = pgt(ji,jj) * rau0_rcp * ( pttbl(ji,jj) - ztfrz(ji,jj) )        ! ocean-ice heat flux (> 0 out) 
    194             pqhc (ji,jj) = pqfwf(ji,jj) * ztfrz(ji,jj) * rcp                              ! heat content   flux (> 0 out) 
    195             zqcon(ji,jj) = zeps3 * ( ztfrz(ji,jj) - rtsurf ) ! to be check 
     216            pqfwf(ji,jj) = rau0     * pgs(ji,jj) * ( zsfrz - pstbl(ji,jj) ) / MAX(zsfrz,zeps) ! fresh water flux    (> 0 out) 
     217            pqoce(ji,jj) = rau0_rcp * pgt(ji,jj) * zthd (ji,jj)                               ! ocean-ice heat flux (> 0 out) 
     218            pqhc (ji,jj) = rcp      * pqfwf(ji,jj) * ztfrz(ji,jj)                             ! heat content  flux (> 0 out) 
     219            ! 
     220            zqcon(ji,jj) = zeps3 * ( ztfrz(ji,jj) - rtsurf )                                  ! conductive flux through the ice (> 0 out) 
    196221            ! 
    197222         END DO 
    … …  
    202227      ! 
    203228      ! output thermal driving 
    204       CALL iom_put('isfthermald_cav',( pttbl(:,:) - ztfrz(:,:) )) 
     229      CALL iom_put('isfthermald_cav', zthd) 
    205230      ! 
    206231   END SUBROUTINE isfmlt_3eq 
     232 
     233   SUBROUTINE isfmlt_oasis(kt, pstbl,              &  ! <<== in 
     234      &                        pqhc , pqoce, pqfwf )  ! ==>> out 
     235      !!---------------------------------------------------------------------- 
     236      !! 
     237      !! ** Purpose    : scale the fwf read from input file by the total amount received by the sbccpl interface 
     238      !! 
     239      !! ** Purpose    : - read ice shelf melt from forcing file => pattern 
     240      !!                 - total amount of fwf is given by sbccpl (fwfisf_cpl) 
     241      !!                 - scale fwf and compute heat fluxes 
     242      !! 
     243      !!--------------------------------------------------------------------- 
     244      !!-------------------------- OUT ------------------------------------- 
     245      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes 
     246      !!-------------------------- IN  ------------------------------------- 
     247      INTEGER                     , INTENT(in   ) :: kt                  ! current time step 
     248      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pstbl               ! salinity in tbl 
     249      !!-------------------------------------------------------------------- 
     250      REAL(wp)                     :: zfwf_fld, zfwf_cpl                 ! total fwf in the forcing fields (pattern) and from the cpl interface (amount) 
     251      REAL(wp), DIMENSION(jpi,jpj) :: ztfrz                              ! tbl freezing temperature 
     252      REAL(wp), DIMENSION(jpi,jpj) :: zfwf                               ! 2d fwf map after scaling 
     253      !!-------------------------------------------------------------------- 
     254      ! 
     255      ! Calculate freezing temperature 
     256      CALL eos_fzp( pstbl(:,:), ztfrz(:,:), risfdep(:,:) ) 
     257      ! 
     258      ! read input file 
     259      CALL fld_read ( kt, nn_fsbc, sf_isfcav_fwf ) 
     260      ! 
     261      ! ice shelf 2d map 
     262      zfwf(:,:) = - sf_isfcav_fwf(1)%fnow(:,:,1) 
     263      ! 
     264      ! compute glob sum from input file 
     265      zfwf_fld = glob_sum('isfcav_mlt', zfwf(:,:)) 
     266      ! 
     267      ! compute glob sum from atm->oce ice shelf fwf 
     268      zfwf_cpl = glob_sum('isfcav_mlt', fwfisf_cpl(:,:)) 
     269      ! 
     270      ! scale fwf 
     271      zfwf(:,:) = zfwf(:,:) * zfwf_cpl / zfwf_fld 
     272      !  
     273      ! define fwf and qoce 
     274      ! ocean heat flux is assume to be equal to the latent heat 
     275      pqfwf(:,:) =   zfwf(:,:)                         ! fwf                ( >0 out) 
     276      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out) 
     277      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out) 
     278      ! 
     279   END SUBROUTINE isfmlt_oasis 
    207280 
    208281   !SUBROUTINE isfmlt_3eq_frz_ktm1 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfgammats.F90

    r11395 r11403  
    5353      !!--------------------------------------------------------------------- 
    5454      ! 
    55       ! compute velocity in the tbl 
     55      ! compute velocity in the tbl if needed 
    5656      SELECT CASE ( cn_gammablk ) 
    57       CASE ( 'spe'  ) ! gamma is constant (specified in namelist) 
    58       ! nothing to do 
     57      CASE ( 'spe'  )  
     58         ! gamma is constant (specified in namelist) 
     59         ! nothing to do 
    5960      CASE ('ad15', 'hj99') 
    6061         CALL isf_tbl(un(:,:,:) ,zutbl(:,:),'U') 
    … …  
    9495      !! ** Purpose    : compute the coefficient echange coefficient  
    9596      !! 
    96       !! ** Method     : gamma is velocity dependent (gt= gt0 * Ustar 
     97      !! ** Method     : gamma is velocity dependent ( gt= gt0 * Ustar ) 
    9798      !! 
    9899      !! ** Reference  : Jenkins et al., 2010, JPO, p2298-2312 
    99       !!                 Asay-Davis et al. (2015) 
     100      !!                 Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016 
    100101      !!--------------------------------------------------------------------- 
    101102      !!-------------------------- OUT ------------------------------------- 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfhdiv.F90

    r11395 r11403  
    11MODULE isfhdiv 
    22 
    3 USE oce 
    4 USE dom_oce 
    5 USE isf 
    6 USE isfutils 
    7 USE phycst 
     3   USE dom_oce 
     4   USE isf 
     5   USE phycst 
    86 
    9 IMPLICIT NONE 
     7   IMPLICIT NONE 
    108 
    11 PRIVATE 
     9   PRIVATE 
    1210 
    13 PUBLIC isf_hdiv 
     11   PUBLIC isf_hdiv 
    1412 
    1513CONTAINS 
    … …  
    5957      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6058      INTEGER  ::   ikt, ikb  
    61       REAL(wp), DIMENSION(jpi,jpj) :: zqvol 
     59      REAL(wp), DIMENSION(jpi,jpj) :: zqvol,ztmp 
    6260      !!---------------------------------------------------------------------- 
    6361      ! 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfnxt.F90

    r11395 r11403  
    11MODULE isfnxt 
     2   !!========================================================================= 
     3   !!                       ***  MODULE  isfnxt  *** 
     4   !! Ice shelf update: compute the dynnxt ice shelf contribution 
     5   !!========================================================================= 
     6   !! History :  OPA  !  2019-09  (P. Mathiot)  Original code 
     7   !!------------------------------------------------------------------------- 
     8   
     9   !!------------------------------------------------------------------------- 
     10   !!   dyn_nxt       : obtain the next (after) horizontal velocity 
     11   !!------------------------------------------------------------------------- 
    212 
    3 USE isf 
    4 USE isfutils 
     13   USE isf 
     14   USE dom_oce 
     15   USE in_out_manager 
    516 
    6 USE dom_oce 
    7 USE in_out_manager 
     17   IMPLICIT NONE 
    818 
    9 IMPLICIT NONE 
     19   PRIVATE 
    1020 
    11 PRIVATE 
    12  
    13 PUBLIC isf_dynnxt !, isf_tranxt_mlt, isf_dynnxt_cpl, isf_tranxt_cpl 
     21   PUBLIC isf_dynnxt ! isf_tranxt 
    1422 
    1523CONTAINS 
    1624 
    1725   SUBROUTINE isf_dynnxt ( pcoef ) 
    18       !!---------------------------------------------------------------------- 
     26      !!-------------------------------------------------------------------- 
     27      !!                  ***  ROUTINE isf_dynnxt  *** 
     28      !! 
     29      !! ** Purpose : compute the ice shelf volume filter correction for cavity, param, ice sheet coupling case 
     30      !! 
     31      !!-------------------------------------------------------------------- 
     32      !!-------------------------- OUT ------------------------------------- 
    1933      REAL(wp),                     INTENT(in   ) :: pcoef           ! atfp * rdt * r1_rau0 
    20       !!---------------------------------------------------------------------- 
     34      !!-------------------------- IN  ------------------------------------- 
     35      !!-------------------------------------------------------------------- 
     36      !!-------------------------------------------------------------------- 
    2137      ! 
    2238      ! ice shelf cavity 
    … …  
    3248 
    3349   SUBROUTINE isf_dynnxt_mlt ( ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, pcoef ) 
    34    !atfp * rdt * r1_rau0 
    35       !!---------------------------------------------------------------------- 
     50      !!-------------------------------------------------------------------- 
     51      !!                  ***  ROUTINE isf_dynnxt_mlt  *** 
     52      !! 
     53      !! ** Purpose : compute the ice shelf volume filter correction for cavity or param 
     54      !! 
     55      !!-------------------------------------------------------------------- 
     56      !!-------------------------- OUT ------------------------------------- 
     57      !!-------------------------- IN  ------------------------------------- 
    3658      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) :: ktop , kbot     ! top and bottom level of tbl 
    3759      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfrac, phtbl    ! fraction of bottom cell included in tbl, tbl thickness 
    … …  
    4668      zfwfinc(:,:) = pcoef * ( pfwf_b(:,:) - pfwf(:,:) ) / phtbl(:,:) 
    4769      ! 
    48       ! add the in depth increment 
     70      ! add the increment in the tbl 
    4971      DO jk = 1, jpkm1 
    5072         DO jj = 1, jpj 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfpar.F90

    r11395 r11403  
    5858      INTEGER, INTENT(in) ::   kt                                           ! ocean time step 
    5959      !!--------------------------------------------------------------------- 
    60       !!--------------------------------------------------------------------- 
    6160      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh 
    6261      !!--------------------------------------------------------------------- 
    … …  
    106105      CALL isf_alloc_par() 
    107106      ! 
     107      ! par 
     108      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1          
     109      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp 
     110      ! 
     111      mskisf_par(:,:) = 0 
     112      ! 
    108113      ! define isf tbl tickness, top and bottom indice 
    109114      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax) 
    … …  
    126131      ! 
    127132      ! compute misfkb_par, rhisf_tbl 
    128       rhisf_tbl(:,:) = rhisf0_tbl_par(:,:) 
     133      rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 
    129134      CALL isf_tbl_lvl( ht_n, e3t_n, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    130135      ! 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfparmlt.F90

    r11395 r11403  
    11MODULE isfparmlt 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcisf  *** 
     3   !!                       ***  MODULE  isfparmlt  *** 
    44   !! Surface module :  update surface ocean boundary condition under ice 
    55   !!                   shelf 
    … …  
    1818   USE iom            ! I/O library 
    1919   USE fldread 
     20   USE lib_fortran 
    2021 
    2122   IMPLICIT NONE 
    … …  
    4344      !!              melting and freezing  
    4445      !! 
    45       !! ** Method  :  2 parameterizations are available according to XXXXX 
     46      !! ** Method  :  2 parameterizations are available according 
     47      !!                        1 : Specified melt flux 
    4648      !!                        2 : Beckmann & Goose parameterization 
    47       !!                        3 : Specified runoff in deptht (Mathiot & al. 2017) 
    4849      !!---------------------------------------------------------------------- 
    4950      !!-------------------------- OUT ------------------------------------- 
    … …  
    6061         CALL isfpar_mlt_bg03(kt, pqhc, pqoce, pqfwf) 
    6162      CASE ( 'oasis' ) 
    62          !CALL isfpar_mlt_oasis 
     63         CALL isfpar_mlt_oasis( kt, pqhc, pqoce, pqfwf) 
    6364      CASE DEFAULT 
    6465         CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfpar (should not see this)') 
    … …  
    7374   SUBROUTINE isfpar_mlt_spe(kt, pqhc, pqfwf, pqoce) 
    7475      !!--------------------------------------------------------------------- 
    75       !!                  ***  ROUTINE sbc_isf_bg03  *** 
     76      !!                  ***  ROUTINE isfpar_mlt_spe  *** 
    7677      !! 
    7778      !! ** Purpose : prescribed ice shelf melting in case ice shelf cavities are closed. 
    7879      !!              data read into a forcing files. 
    7980      !! 
    80       !! ** Reference : Mathiot et al. (2017) 
    8181      !!---------------------------------------------------------------------- 
    8282      !!-------------------------- OUT ------------------------------------- 
    … …  
    9090      !!-------------------------------------------------------------------- 
    9191      ! 
    92       ! specified runoff in depth (Mathiot et al., 2017) 
     92      ! 0. ------------Read specified runoff 
    9393      CALL fld_read ( kt, nn_fsbc, sf_isfpar_fwf   ) 
    9494      ! 
    9595      ! compute ptfrz 
     96      ! 1. ------------Mean freezing point 
     97      DO jk = 1,jpk 
     98         CALL eos_fzp(tsn(:,:,jk,jp_sal), ztfrz3d(:,:,jk), gdept_n(:,:,jk)) 
     99      END DO 
     100      CALL isf_tbl(ztfrz3d, ztfrz, 'T', misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     101      ! 
     102      pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)      ! fresh water flux from the isf (fwfisf <0 mean melting)  
     103      pqoce(:,:) =   pqfwf(:,:) * rLfusisf             ! ocean/ice shelf flux assume to be equal to latent heat flux 
     104      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  
     105      ! 
     106   END SUBROUTINE isfpar_mlt_spe 
     107 
     108   SUBROUTINE isfpar_mlt_bg03(kt, pqhc, pqoce, pqfwf) 
     109      !!--------------------------------------------------------------------- 
     110      !!                  ***  ROUTINE isfpar_mlt_bg03  *** 
     111      !! 
     112      !! ** Purpose : compute an estimate of ice shelf melting and  
     113      !!              latent, ocean-ice and heat content heat fluxes 
     114      !!              in case cavities are closed based on the far fields T and S properties.  
     115      !! 
     116      !! ** Method  : The ice shelf melt is computed as proportional to the differences between the  
     117      !!              mean temperature and mean freezing point in front of the ice shelf averaged  
     118      !!              over the ice shelf min ice shelf draft and max ice shelf draft and the freezing point 
     119      !! 
     120      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean 
     121      !!                interaction for climate models", Ocean Modelling 5(2003) 157-170. 
     122      !!---------------------------------------------------------------------- 
     123      !!-------------------------- OUT ------------------------------------- 
     124      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf,pqoce  ! fresh water and ice-ocean heat fluxes 
     125      !!-------------------------- IN  ------------------------------------- 
     126      INTEGER,  INTENT(in) :: kt 
     127      !!-------------------------------------------------------------------- 
     128      INTEGER :: jk 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d        ! freezing point 
     130      REAL(wp), DIMENSION(jpi,jpj)     :: ztfrz          ! freezing point 
     131      REAL(wp), DIMENSION(jpi,jpj)     :: ztavg          ! temperature avg 
     132      !!---------------------------------------------------------------------- 
     133      ! 
    96134      ! 0. ------------Mean freezing point 
    97135      DO jk = 1,jpk 
    … …  
    100138      CALL isf_tbl(ztfrz3d, ztfrz, 'T', misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    101139      ! 
    102       pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)      ! fresh water flux from the isf (fwfisf <0 mean melting)  
    103       pqoce(:,:) =   pqfwf(:,:) * rLfusisf             ! ocean/ice shelf flux assume to be equal to latent heat flux 
     140      ! 1. ------------Mean temperature 
     141      CALL isf_tbl(tsn(:,:,jk,jp_tem), ztavg, 'T', misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
     142      ! 
     143      ! 2. ------------Net heat flux and fresh water flux due to the ice shelf 
     144      pqoce(:,:) =   rau0 * rcp * rn_gammat0 * risfLeff(:,:) * e1t(:,:) * ( ztavg(:,:) - ztfrz(:,:) ) * r1_e1e2t(:,:) 
     145      pqfwf(:,:) = - pqoce(:,:) * r1_Lfusisf           ! derived from the latent heat flux 
    104146      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  
    105147      ! 
    106    END SUBROUTINE isfpar_mlt_spe 
    107  
    108    SUBROUTINE isfpar_mlt_bg03(kt, pqhc, pqoce, pqfwf) 
    109       !!--------------------------------------------------------------------- 
    110       !!                  ***  ROUTINE sbc_isf_bg03  *** 
    111       !! 
    112       !! ** Purpose : compute an estimate of ice shelf melting in case cavities are closed 
    113       !!              based on the far fields T and S properties.  
    114       !! 
    115       !! ** Method  :   See reference 
    116       !! 
    117       !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean 
    118       !!         interaction for climate models", Ocean Modelling 5(2003) 157-170. 
    119       !!         (hereafter BG) 
    120       !!---------------------------------------------------------------------- 
    121       !!-------------------------- OUT ------------------------------------- 
    122       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf,pqoce  ! fresh water and ice-ocean heat fluxes 
    123       !!-------------------------- IN  ------------------------------------- 
    124       INTEGER,  INTENT(in) :: kt 
    125       !!-------------------------------------------------------------------- 
    126       INTEGER :: jk 
    127       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d        ! freezing point 
    128       REAL(wp), DIMENSION(jpi,jpj)     :: ztfrz          ! freezing point 
    129       REAL(wp), DIMENSION(jpi,jpj)     :: ztavg          ! temperature avg 
    130       !!---------------------------------------------------------------------- 
    131       ! 
    132       ! 0. ------------Mean freezing point 
     148      ! 3. ------------BG03 output 
     149      ! output ttbl 
     150      CALL iom_put('ttbl_par', ztavg(:,:) ) 
     151      ! 
     152      ! output thermal driving 
     153      CALL iom_put('isfthermald_par',( ztfrz(:,:) - ztavg(:,:) )) 
     154      ! 
     155      ! 
     156   END SUBROUTINE isfpar_mlt_bg03 
     157 
     158   SUBROUTINE isfpar_mlt_oasis(kt, pqhc , pqoce, pqfwf ) 
     159      !!---------------------------------------------------------------------- 
     160      !! 
     161      !! ** Purpose    : scale the fwf read from input file by the total amount received by the sbccpl interface 
     162      !! 
     163      !! ** Purpose    : - read ice shelf melt from forcing file => pattern 
     164      !!                 - total amount of fwf is given by sbccpl (fwfisf_cpl) 
     165      !!                 - scale fwf and compute heat fluxes 
     166      !! 
     167      !!--------------------------------------------------------------------- 
     168      !!-------------------------- OUT ------------------------------------- 
     169      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes 
     170      !!-------------------------- IN  ------------------------------------- 
     171      INTEGER                     , INTENT(in   ) :: kt                  ! current time step 
     172      !!-------------------------------------------------------------------- 
     173      INTEGER                           :: jk                            ! loop index 
     174      REAL(wp)                          :: zfwf_fld, zfwf_cpl            ! total fwf in the forcing fields (pattern) and from the cpl interface (amount) 
     175      REAL(wp), DIMENSION(jpi,jpj)      :: ztfrz                         ! tbl freezing temperature 
     176      REAL(wp), DIMENSION(jpi,jpj)      :: zfwf                          ! 2d fwf map after scaling 
     177      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: ztfrz3d 
     178      !!-------------------------------------------------------------------- 
     179      ! 
     180      ! 0. ------------Read specified runoff 
     181      CALL fld_read ( kt, nn_fsbc, sf_isfpar_fwf   ) 
     182      ! 
     183      ! compute ptfrz 
     184      ! 1. ------------Mean freezing point 
    133185      DO jk = 1,jpk 
    134186         CALL eos_fzp(tsn(:,:,jk,jp_sal), ztfrz3d(:,:,jk), gdept_n(:,:,jk)) 
    … …  
    136188      CALL isf_tbl(ztfrz3d, ztfrz, 'T', misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    137189      ! 
    138       ! 1. ------------Mean temperature 
    139       CALL isf_tbl(tsn(:,:,jk,jp_tem), ztavg, 'T', misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 
    140       ! 
    141       ! 2. ------------Net heat flux and fresh water flux due to the ice shelf 
    142       pqoce(:,:) = - rau0 * rcp * rn_gammat0 * risfLeff(:,:) * e1t(:,:) * ( ztfrz(:,:) - ztavg(:,:) ) * r1_e1e2t(:,:) 
    143       pqfwf(:,:) =   pqoce(:,:) / rLfusisf 
    144       pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  
    145       ! 
    146       ! output ttbl 
    147       CALL iom_put('ttbl_par', ztavg(:,:) ) 
    148       ! 
    149       ! output thermal driving 
    150       CALL iom_put('isfthermald_par',( ztfrz(:,:) - ztavg(:,:) )) 
    151       ! 
    152       ! 
    153    END SUBROUTINE isfpar_mlt_bg03 
    154  
    155    SUBROUTINE isfpar_mlt_oasis 
    156    !TODO 
     190      ! ice shelf 2d map 
     191      zfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1) 
     192      ! 
     193      ! compute glob sum from input file 
     194      zfwf_fld = glob_sum('isfcav_mlt', zfwf(:,:)) 
     195      ! 
     196      ! compute glob sum from atm->oce ice shelf fwf 
     197      zfwf_cpl = glob_sum('isfcav_mlt', fwfisf_cpl(:,:)) 
     198      ! 
     199      ! scale fwf 
     200      zfwf(:,:) = zfwf(:,:) * zfwf_cpl / zfwf_fld 
     201      !  
     202      ! define fwf and qoce 
     203      ! ocean heat flux is assume to be equal to the latent heat 
     204      pqfwf(:,:) =   zfwf(:,:)                         ! fwf                ( >0 out ) 
     205      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out ) (assumed to be the latent heat flux) 
     206      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out ) 
     207      ! 
    157208   END SUBROUTINE isfpar_mlt_oasis 
    158209 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfrst.F90

    r11395 r11403  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  isfrst  *** 
    4    !! iceshelf restart module :read and write iceshelf variables in/from restart 
     4   !! iceshelf restart module :read/write iceshelf variables from/in restart 
    55   !!====================================================================== 
    66   !! History :  4.1  !  2019-07  (P. Mathiot) Original code 
    … …  
    3030   !  
    3131   SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 
    32       !!---------------------------------------------------------------------- 
     32      !!--------------------------------------------------------------------- 
    3333      !!   isfrst_read : read iceshelf variables from restart 
    34       !!---------------------------------------------------------------------- 
     34      !!--------------------------------------------------------------------- 
     35      !!-------------------------- OUT -------------------------------------- 
     36      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) :: pfwf_b 
     37      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(  out) :: ptsc_b 
     38      !!-------------------------- IN  -------------------------------------- 
    3539      CHARACTER(LEN=256)               , INTENT(in   ) :: cdisf 
    3640      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) :: pfwf 
    37       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pfwf_b 
    3841      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc 
    39       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc_b 
    4042      !!---------------------------------------------------------------------- 
    4143      CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b 
    … …  
    6769   !  
    6870   SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf ) 
    69       !!---------------------------------------------------------------------- 
     71      !!--------------------------------------------------------------------- 
    7072      !!   isfrst_write : write iceshelf variables in restart 
    71       !!---------------------------------------------------------------------- 
     73      !!--------------------------------------------------------------------- 
     74      !!-------------------------- OUT -------------------------------------- 
     75      !!-------------------------- IN  -------------------------------------- 
    7276      INTEGER                     , INTENT(in   ) :: kt 
    7377      CHARACTER(LEN=256)          , INTENT(in   ) :: cdisf 
    7478      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) :: pfwf 
    7579      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) :: ptsc 
    76       !!---------------------------------------------------------------------- 
     80      !!--------------------------------------------------------------------- 
    7781      CHARACTER(LEN=256) :: cfwf_b, chc_b, csc_b 
    78       !!---------------------------------------------------------------------- 
     82      !!--------------------------------------------------------------------- 
    7983      ! 
    8084      ! ocean output print 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfstp.F90

    r11395 r11403  
    1 MODULE isfmlt 
     1MODULE isfstp 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcisf  *** 
    4    !! Surface module :  compute iceshelf melt and heat flux 
     3   !!                       ***  MODULE  isfstp  *** 
     4   !! Surface module :  compute iceshelf load, melt and heat flux 
    55   !!====================================================================== 
    66   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav 
    … …  
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   isfmlt       : compute iceshelf melt and heat flux 
     13   !!   isfstp       : compute iceshelf melt and heat flux 
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce            ! ocean dynamics and tracers 
    … …  
    3030   USE isfpar         ! ice shelf parametrisation 
    3131   USE isfcav         ! ice shelf cavity 
     32   USE isfload        ! ice shelf load 
    3233   USE isf            ! isf variables 
    3334 
    … …  
    3637   PRIVATE 
    3738 
    38    PUBLIC   isf_mlt, isf_mlt_init  ! routine called in sbcmod and divhor 
     39   PUBLIC   isf_stp, isf_stp_init  ! routine called in sbcmod and divhor 
    3940 
    4041   !!---------------------------------------------------------------------- 
    … …  
    4546CONTAINS 
    4647  
    47   SUBROUTINE isf_mlt( kt ) 
     48  SUBROUTINE isf_stp( kt ) 
    4849      !!--------------------------------------------------------------------- 
    49       !!                  ***  ROUTINE isf_mlt  *** 
    50       !! 
    51       !! ** Purpose :  
    52       !! 
    53       !! ** Method  :  
     50      !!                  ***  ROUTINE isf_stp  *** 
     51      !! 
     52      !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt 
     53      !! 
     54      !! ** Method  : For each case (parametrisation or explicity cavity) : 
     55      !!              - define the before fields 
     56      !!              - compute top boundary layer properties 
     57      !!                (in case of parametrisation, this is the  
     58      !!                 depth range model array used to compute mean far fields properties) 
     59      !!              - compute fluxes 
     60      !!              - write restart variables 
    5461      !! 
    5562      !!---------------------------------------------------------------------- 
    … …  
    95102      END IF 
    96103      ! 
    97    END SUBROUTINE isf_mlt 
    98  
    99    SUBROUTINE isf_mlt_init 
     104   END SUBROUTINE isf_stp 
     105 
     106   SUBROUTINE isf_stp_init 
    100107      !!--------------------------------------------------------------------- 
    101       !!                  ***  ROUTINE isfmlt_init  *** 
    102       !! 
    103       !! ** Purpose : 
    104       !! 
    105       !! ** Method  : 
    106       !! 
     108      !!                  ***  ROUTINE isfstp_init  *** 
     109      !! 
     110      !! ** Purpose :   Initialisation of the ice shelf public variables 
     111      !! 
     112      !! ** Method  :   Read the namsbc namelist and set derived parameters 
     113      !!                Call init routines for all other SBC modules that have one 
     114      !! 
     115      !! ** Action  : - read namsbc parameters 
     116      !!              - allocate memory 
     117      !!              - call cav/param init routine 
    107118      !!---------------------------------------------------------------------- 
    108119      INTEGER               :: inum, ierror 
    … …  
    114125         &             ln_isfpar_mlt, cn_isfpar_mlt, sn_isfpar_fwf, sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff 
    115126      !!---------------------------------------------------------------------- 
    116  
     127      ! 
     128      ! Allocate public array 
     129      CALL isf_alloc() 
     130      ! 
     131      riceload(:,:)       = 0.0_wp 
     132      fwfisf_cpl(:,:)     = 0.0_wp 
     133      fwfisf_par(:,:)     = 0.0_wp    ; fwfisf_par_b(:,:)     = 0.0_wp 
     134      fwfisf_cav(:,:)     = 0.0_wp    ; fwfisf_cav_b(:,:)     = 0.0_wp 
     135      risf_cav_tsc(:,:,:) = 0.0_wp    ; risf_cav_tsc_b(:,:,:) = 0.0_wp 
     136      risf_par_tsc(:,:,:) = 0.0_wp    ; risf_par_tsc_b(:,:,:) = 0.0_wp 
     137      ! 
     138      ! terminate routine now if no ice shelf melt formulation specify 
     139      IF ( .NOT. ln_isf ) RETURN 
     140      ! 
    117141      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    118142      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 
    119143901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist', lwp ) 
    120  
     144      ! 
    121145      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs 
    122146      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 
    … …  
    128152      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    129153      IF(lwp) WRITE(numout,*) '   Namelist namisf :' 
     154      ! 
    130155      IF(lwp) WRITE(numout,*) '      melt inside the cavity                  ln_isfcav_mlt   = ', ln_isfcav_mlt 
    131156      IF ( ln_isfcav ) THEN 
    … …  
    139164         END IF 
    140165      END IF 
     166      ! 
    141167      IF(lwp) WRITE(numout,*) '' 
     168      ! 
    142169      IF(lwp) WRITE(numout,*) '      ice shelf melt parametrisation          ln_isfpar_mlt    = ', ln_isfpar_mlt 
    143170      IF ( ln_isfpar_mlt ) THEN 
    … …  
    146173      IF(lwp) WRITE(numout,*) '' 
    147174      ! 
    148       ! Allocate public array 
    149       CALL isf_alloc() 
    150       ! 
    151       ! initialisation 
    152       ! cav 
    153       misfkt_cav(:,:)     = mikt(:,:) ; misfkb_cav(:,:)       = mikt(:,:) 
    154       fwfisf_cav(:,:)     = 0.0_wp    ; fwfisf_cav_b(:,:)     = 0.0_wp 
    155       rhisf_tbl_cav(:,:)  = 1e-20     ; rfrac_tbl_cav(:,:)    = 0.0_wp 
    156       risf_cav_tsc(:,:,:) = 0.0_wp    ; risf_cav_tsc_b(:,:,:) = 0.0_wp 
    157       ! 
    158       mskisf_cav(:,:) = (1._wp - tmask(:,:,1)) * ssmask(:,:) 
    159       ! 
    160       ! par 
    161       misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1          
    162       fwfisf_par(:,:)     = 0.0_wp    ; fwfisf_par_b(:,:)     = 0.0_wp 
    163       rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp 
    164       risf_par_tsc(:,:,:) = 0.0_wp    ; risf_par_tsc_b(:,:,:) = 0.0_wp 
    165       ! 
    166       mskisf_par(:,:) = 0 
     175      ! sanity check 
     176      ! melt in the cavity without cavity 
     177      IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) & 
     178         &   CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' ) 
     179      ! 
     180      IF ( ln_cpl ) THEN 
     181         ! 
     182         CALL ctl_stop( ' ln_ctl and ice shelf not tested' ) 
     183         ! 
     184         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation  
     185         IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble with ln_cpl' ) 
     186         IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble with ln_cpl' ) 
     187         ! 
     188         ! oasis melt computation not tested (coded but not tested) 
     189         IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN 
     190            IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' ) 
     191            IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' ) 
     192         END IF 
     193         ! 
     194         ! oasis melt computation with cavity open and cavity parametrised (not coded) 
     195         IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN 
     196            IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' ) 
     197         END IF 
     198      END IF 
     199      ! 
     200      ! initialisation ice shelf load 
     201      IF ( ln_isfcav ) THEN 
     202         ! 
     203         ! compute ice shelf mask 
     204         mskisf_cav(:,:) = (1._wp - tmask(:,:,1)) * ssmask(:,:) 
     205         ! 
     206         ! compute ice shelf load 
     207         CALL isf_load( risfload ) 
     208         ! 
     209      END IF 
    167210      ! 
    168211      ! initialisation useful variable 
    169212      r1_Lfusisf =  1._wp / rLfusisf 
    170213      ! 
    171       DO jj = 1,jpj 
    172          DO ji = 1,jpi 
    173             ikt = mikt(ji,jj) 
    174             ikb = mbkt(ji,jj) 
    175             bathy  (ji,jj) = gdepw_0(ji,jj,ikb+1) 
    176             risfdep(ji,jj) = gdepw_0(ji,jj,ikt  ) 
    177          END DO 
    178       END DO 
    179       ! 
     214      ! initialisation melt in the cavity 
    180215      IF ( ln_isfcav_mlt ) THEN 
    181216         ! 
    … …  
    188223      END IF 
    189224      ! 
     225      ! initialisation parametrised melt 
    190226      IF ( ln_isfpar_mlt ) THEN 
    191227         ! 
    … …  
    198234      END IF 
    199235      ! 
    200   END SUBROUTINE isf_mlt_init 
     236  END SUBROUTINE isf_stp_init 
    201237   !!====================================================================== 
    202 END MODULE isfmlt 
     238END MODULE isfstp 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isftbl.F90

    r11395 r11403  
    11MODULE isftbl 
    2  
    3 USE in_out_manager 
    4 USE dom_oce 
    5 USE oce 
    6 USE isf 
    7 USE lbclnk 
    8  
    9 IMPLICIT NONE 
    10  
    11 PRIVATE 
    12  
    13 PUBLIC isf_tbl, isf_tbl_avg, isf_tbl_lvl, isftbl_ktop, isftbl_kbot 
     2   !!====================================================================== 
     3   !!                       ***  MODULE  isftbl  *** 
     4   !! isftbl module :  compute properties of top boundary layer 
     5   !!====================================================================== 
     6   !! History :  4.1  !  2019-09  (P. Mathiot) original code 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   isftbl       : routine to compute :  
     11   !!                  - geometry of the ice shelf tbl (isf_tbl_lvl, isftbl_ktop, isftbl_kbot) 
     12   !!                    (top and bottom level, thickness and fraction of deepest level affected) 
     13   !!                  - tbl averaged properties (isf_tbl, isf_tbl_avg) 
     14   !!---------------------------------------------------------------------- 
     15 
     16   USE dom_oce ! vertical scale factor 
     17   USE lbclnk  ! lbc_lnk subroutine 
     18 
     19   IMPLICIT NONE 
     20 
     21   PRIVATE 
     22 
     23   PUBLIC isf_tbl, isf_tbl_avg, isf_tbl_lvl, isftbl_ktop, isftbl_kbot 
    1424 
    1525CONTAINS 
    1626 
    1727   SUBROUTINE isf_tbl( pvarin, pvarout, cd_ptin, ktop, kbot, phtbl, pfrac ) 
    18       !!---------------------------------------------------------------------- 
    19       !!                  ***  SUBROUTINE sbc_isf_tbl  *** 
     28      !!-------------------------------------------------------------------- 
     29      !!                  ***  SUBROUTINE isf_tbl  *** 
    2030      !! 
    2131      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point 
    2232      !! 
    23       !!---------------------------------------------------------------------- 
    24       !!-------------------------- OUT ------------------------------------- 
    25       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvarout ! 2d average of pvarin 
    26       !!-------------------------- IN  ------------------------------------- 
    27       CHARACTER(len=1),                       INTENT(in   ) :: cd_ptin ! point of variable in/out 
    28       INTEGER,  DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: ktop , kbot 
    29       REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: phtbl, pfrac 
    30       REAL(wp), DIMENSION(jpi,jpj,jpk),       INTENT(in   ) :: pvarin  ! 3d variable to average over the tbl 
     33      !!-------------------------------------------------------------------- 
     34      !!-------------------------- OUT ------------------------------------- 
     35      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) :: pvarout ! 2d average of pvarin 
     36      !!-------------------------- IN  ------------------------------------- 
     37      CHARACTER(len=1)                      , INTENT(in   ) :: cd_ptin       ! point of variable in/out 
     38      REAL(wp), DIMENSION(jpi,jpj,jpk)      , INTENT(in   ) :: pvarin        ! 3d variable to average over the tbl 
     39      !!-------------------------- IN OPTIONAL ----------------------------- 
     40      INTEGER,  DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: ktop , kbot   ! top and bottom level 
     41      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: phtbl, pfrac  ! tbl thickness and fraction of bottom cell affected 
    3142      !!-------------------------------------------------------------------- 
    3243      INTEGER ::   ji, jj                   ! loop index 
    … …  
    3445      REAL(wp), DIMENSION(jpi,jpj) :: zhtbl ! thickness of the tbl 
    3546      REAL(wp), DIMENSION(jpi,jpj) :: zfrac ! thickness of the tbl 
    36       !!---------------------------------------------------------------------- 
     47      !!-------------------------------------------------------------------- 
    3748      !  
    3849      SELECT CASE ( cd_ptin ) 
    … …  
    8697 
    8798   SUBROUTINE isf_tbl_avg( ktop, kbot, phtbl, pfrac, pe3, pvarin, pvarout ) 
    88       !!--------------------------------------------------------------------- 
     99      !!-------------------------------------------------------------------- 
    89100      !!                  ***  ROUTINE isf_tbl_lvl  *** 
    90101      !! 
    91102      !! ** Purpose : compute mean property in the boundary layer 
    92103      !! 
    93       !!---------------------------------------------------------------------- 
    94       !!-------------------------- OUT ------------------------------------- 
    95       REAL(wp), DIMENSION(:,:)  , INTENT(  out) :: pvarout 
    96       !!-------------------------- IN  ------------------------------------- 
    97       INTEGER,  DIMENSION(jpi,jpj), INTENT(in) :: ktop, kbot   ! top and bottom level of the top boundary layer 
    98       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac !! fraction of bottom level of the tbl to be affected by the tbl 
    99       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pe3      ! vertical scale factor 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvarin   ! tbl property to average between ktop, kbot over phtbl 
    101       !!--------------------------------------------------------------------- 
     104      !! ** Method  : Depth average is made between the top level ktop and the bottom level kbot 
     105      !!              over a thickness phtbl. The bottom level is partially counted (pfrac). 
     106      !! 
     107      !!-------------------------------------------------------------------- 
     108      !!-------------------------- OUT ------------------------------------- 
     109      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pvarout      ! tbl property averaged over phtbl between level ktop and kbot 
     110      !!-------------------------- IN  ------------------------------------- 
     111      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop, kbot   ! top and bottom level of the top boundary layer 
     112      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl 
     113      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3          ! vertical scale factor 
     114      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvarin       ! tbl property to average between ktop, kbot over phtbl 
     115      !!-------------------------------------------------------------------- 
    102116      INTEGER  :: ji,jj,jk                    ! loop indices 
    103117      INTEGER  :: ikt, ikb                    ! top and bottom levels 
    104       !!--------------------------------------------------------------------- 
     118      !!-------------------------------------------------------------------- 
    105119      ! 
    106120      ! compute tbl top.bottom level and thickness 
    … …  
    123137 
    124138   SUBROUTINE isf_tbl_lvl( phw, pe3, ktop, kbot, phtbl, pfrac ) 
    125       !!--------------------------------------------------------------------- 
     139      !!-------------------------------------------------------------------- 
    126140      !!                  ***  ROUTINE isf_tbl_lvl  *** 
    127141      !! 
    … …  
    129143      !!              - thickness of the top boundary layer 
    130144      !! 
    131       !!---------------------------------------------------------------------- 
    132       !!-------------------------- OUT ------------------------------------- 
    133       INTEGER,  DIMENSION(jpi,jpj), INTENT(inout) :: kbot         ! bottom level of the top boundary layer 
    134       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtbl        ! top boundary layer thickness 
    135       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pfrac        ! top boundary layer thickness 
    136       !!-------------------------- IN  ------------------------------------- 
    137       INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in) :: ktop       ! top level of the top boundary layer 
    138       REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in) :: phw        ! water column thickness 
    139       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pe3         ! vertical scale factor 
     145      !!-------------------------------------------------------------------- 
     146      !!-------------------------- OUT ------------------------------------- 
     147      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer 
     148      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: phtbl  ! top boundary layer thickness 
     149      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pfrac  ! top boundary layer thickness 
     150      !!-------------------------- IN  ------------------------------------- 
     151      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer 
     152      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phw    ! water column thickness 
     153      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor 
    140154      !!--------------------------------------------------------------------- 
    141155      INTEGER :: ji,jj,jk 
    … …  
    178192   ! 
    179193   SUBROUTINE isftbl_kbot(ktop, phtbl, pe3, kbot) 
    180       !!-------------------------- OUT ------------------------------------- 
    181       INTEGER,  DIMENSION(jpi,jpj), INTENT(inout) :: kbot         ! bottom level of the top boundary layer 
    182       !!-------------------------- IN  ------------------------------------- 
    183       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl           ! top boundary layer thickness 
    184       INTEGER,  DIMENSION(jpi,jpj), INTENT(in) :: ktop            ! top level of the top boundary layer 
    185       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pe3         ! vertical scale factor 
    186       !!--------------------------------------------------------------------- 
     194      !!-------------------------------------------------------------------- 
     195      !!                  ***  ROUTINE isf_tbl_lvl  *** 
     196      !! 
     197      !! ** Purpose : compute bottom level of the isf top boundary layer 
     198      !! 
     199      !!-------------------------------------------------------------------- 
     200      !!-------------------------- OUT ------------------------------------- 
     201      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer 
     202      !!-------------------------- IN  ------------------------------------- 
     203      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl  ! top boundary layer thickness 
     204      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer 
     205      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor 
     206      !!-------------------------------------------------------------------- 
    187207      INTEGER :: ji, jj 
    188208      INTEGER :: ikt, ikb 
    189       !!--------------------------------------------------------------------- 
     209      !!-------------------------------------------------------------------- 
    190210      ! 
    191211      ! phtbl need to be bounded by water column thickness before 
    192212      ! test: if phtbl = water column thickness, should return mbathy 
    193213      ! test: if phtbl = 0 should return ktop 
     214      ! 
    194215      ! get ktbl 
    195216      DO jj = 1,jpj 
    … …  
    208229      ! 
    209230   SUBROUTINE isftbl_ktop(pdep, ktop) 
    210       !!--------------------------------------------------------------------- 
     231      !!-------------------------------------------------------------------- 
    211232      !!                  ***  ROUTINE isf_tbl_lvl  *** 
    212233      !! 
    213234      !! ** Purpose : compute top level of the isf top boundary layer in case of an ice shelf parametrisation 
    214235      !! 
    215       !!---------------------------------------------------------------------- 
    216       !!-------------------------- OUT ------------------------------------- 
    217       INTEGER,  DIMENSION(jpi,jpj), INTENT(inout) :: ktop         ! top level affected by the ice shelf parametrisation 
    218       !!-------------------------- IN  ------------------------------------- 
    219       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pdep            ! top depth of the parametrisation influence 
    220       !!--------------------------------------------------------------------- 
     236      !!-------------------------------------------------------------------- 
     237      !!-------------------------- OUT ------------------------------------- 
     238      INTEGER,  DIMENSION(jpi,jpj), INTENT(  out) :: ktop        ! top level affected by the ice shelf parametrisation 
     239      !!-------------------------- IN  ------------------------------------- 
     240      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pdep        ! top depth of the parametrisation influence 
     241      !!-------------------------------------------------------------------- 
    221242      INTEGER :: ji,jj 
    222243      INTEGER :: ikt 
    223       !!--------------------------------------------------------------------- 
     244      !!-------------------------------------------------------------------- 
     245      ! 
    224246      ! compute top level (need to be recomputed each time (z*, z~)  
    225247      ! be sure pdep is already correctly bounded 
    226248      ! test: this routine run on isfdraft should return mikt 
    227249      ! test: this routine run with pdep = 0 should return 1 
     250      ! 
    228251      DO ji = 1, jpi 
    229252         DO jj = 1, jpj 
    … …  
    234257      END DO 
    235258      ! 
    236    END SUBROUTINE 
     259   END SUBROUTINE isftbl_ktop 
    237260 
    238261END MODULE isftbl 

  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfutils.F90

    r11395 r11403  
    11MODULE isfutils 
     2   !!====================================================================== 
     3   !!                       ***  MODULE  isfutils  *** 
     4   !! istutils module : miscelenious useful routines 
     5   !!====================================================================== 
     6   !! History :  4.1  !  2019-09  (P. Mathiot) original code 
     7   !!---------------------------------------------------------------------- 
    28 
    3 USE oce 
    4 USE in_out_manager 
    5 USE iom 
    6 USE lib_fortran 
    7 USE lib_mpp 
     9   !!---------------------------------------------------------------------- 
     10   !!   isfutils       : - read_2dcstdta to read a constant input file with iom_get 
     11   !!                    - debug to print array sum, min, max in ocean.output 
     12   !!---------------------------------------------------------------------- 
    813 
    9 IMPLICIT NONE 
     14   USE iom 
     15   USE lib_fortran 
     16   USE lib_mpp 
    1017 
    11 PRIVATE 
     18   IMPLICIT NONE 
    1219 
    13 INTERFACE isf_debug 
    14    MODULE PROCEDURE isf_debug2d, isf_debug3d 
    15 END INTERFACE isf_debug 
     20   PRIVATE 
    1621 
    17 PUBLIC read_2dcstdta, isf_debug 
     22   INTERFACE debug 
     23      MODULE PROCEDURE debug2d, debug3d 
     24   END INTERFACE debug 
     25 
     26   PUBLIC read_2dcstdta, debug 
    1827 
    1928CONTAINS 
    2029 
    2130   SUBROUTINE read_2dcstdta(cdfile, cdvar, pvar) 
    22       !!--------------------------------------------------------------------- 
     31      !!-------------------------------------------------------------------- 
    2332      !!                  ***  ROUTINE read_2dcstdta  *** 
    2433      !! 
    2534      !! ** Purpose : read input file 
    2635      !! 
    27       !!---------------------------------------------------------------------- 
     36      !!-------------------------------------------------------------------- 
    2837      !!-------------------------- OUT ------------------------------------- 
    29       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar 
     38      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pvar          ! output variable 
    3039      !!-------------------------- IN  ------------------------------------- 
    31       CHARACTER(len=256), INTENT(in) :: cdfile, cdvar 
     40      CHARACTER(len=256)          , INTENT(in   ) :: cdfile, cdvar ! input file name and variable name 
    3241      !!-------------------------------------------------------------------- 
    3342      INTEGER :: inum 
     43      !!-------------------------------------------------------------------- 
    3444 
    3545      CALL iom_open( cdfile, inum ) 
    … …  
    3949   END SUBROUTINE read_2dcstdta 
    4050 
    41    SUBROUTINE isf_debug2d(cdtxt,pvar) 
    42       CHARACTER(LEN=256), INTENT(in) :: cdtxt 
     51   SUBROUTINE debug2d(cdtxt,pvar) 
     52      !!-------------------------------------------------------------------- 
     53      !!                  ***  ROUTINE isf_debug2d  *** 
     54      !! 
     55      !! ** Purpose : add debug print 
     56      !! 
     57      !!-------------------------------------------------------------------- 
     58      !!-------------------------- OUT ------------------------------------- 
     59      !!-------------------------- IN  ------------------------------------- 
     60      CHARACTER(LEN=256)          , INTENT(in   ) :: cdtxt 
    4361      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pvar 
     62      !!-------------------------------------------------------------------- 
    4463      REAL(wp) :: zmin, zmax, zsum 
    45       zsum = glob_sum( 'isf_debug', pvar(:,:) ) 
    46       zmin = MINVAL( pvar(:,:) ) ; CALL mpp_min( 'isf_debug', zmin ) ! min over the global domain 
    47       zmax = MAXVAL( pvar(:,:) ) ; CALL mpp_max( 'isf_debug', zmax ) ! max over the global domain 
     64      !!-------------------------------------------------------------------- 
     65      ! 
     66      zsum = glob_sum( 'debug', pvar(:,:) ) 
     67      zmin = MINVAL( pvar(:,:) ) ; CALL mpp_min( 'debug', zmin ) ! min over the global domain 
     68      zmax = MAXVAL( pvar(:,:) ) ; CALL mpp_max( 'debug', zmax ) ! max over the global domain 
     69      ! 
    4870      WRITE(numout,*) TRIM(cdtxt),' (min, max, sum) : ',zmin, zmax, zsum 
     71      ! 
    4972      FLUSH(numout) 
    50    END SUBROUTINE isf_debug2d 
     73   END SUBROUTINE debug2d 
    5174 
    52    SUBROUTINE isf_debug3d(cdtxt,pvar) 
    53       CHARACTER(LEN=256), INTENT(in) :: cdtxt 
     75   SUBROUTINE debug3d(cdtxt,pvar) 
     76      !!-------------------------------------------------------------------- 
     77      !!                  ***  ROUTINE isf_debug3d  *** 
     78      !! 
     79      !! ** Purpose : add debug print 
     80      !! 
     81      !!-------------------------------------------------------------------- 
     82      !!-------------------------- OUT ------------------------------------- 
     83      !!-------------------------- IN  ------------------------------------- 
     84      CHARACTER(LEN=256)              , INTENT(in   ) :: cdtxt 
    5485      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvar 
     86      !!-------------------------------------------------------------------- 
    5587      REAL(wp) :: zmin, zmax, zsum 
    56       zsum = glob_sum( 'isf_debug', pvar(:,:) ) 
    57       zmin = MINVAL( pvar(:,:) ) ; CALL mpp_min( 'isf_debug', zmin ) ! min over the global domain 
    58       zmax = MAXVAL( pvar(:,:) ) ; CALL mpp_max( 'isf_debug', zmax ) ! max over the global domain 
     88      !!-------------------------------------------------------------------- 
     89      ! 
     90      zsum = glob_sum( 'debug', pvar(:,:) ) 
     91      zmin = MINVAL( pvar(:,:) ) ; CALL mpp_min( 'debug', zmin ) ! min over the global domain 
     92      zmax = MAXVAL( pvar(:,:) ) ; CALL mpp_max( 'debug', zmax ) ! max over the global domain 
     93      ! 
    5994      WRITE(numout,*) TRIM(cdtxt),' (min, max, sum) : ',zmin, zmax, zsum 
     95      ! 
    6096      FLUSH(numout) 
    61    END SUBROUTINE isf_debug3d 
     97      ! 
     98   END SUBROUTINE debug3d 
    6299 
    63100END MODULE isfutils 
Note: See TracChangeset for help on using the changeset viewer.