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/isfparmlt.F90 – 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)

File:
1 moved

Legend:

Unmodified
Added
Removed
  • 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 
Note: See TracChangeset for help on using the changeset viewer.