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 5823 – NEMO

Changeset 5823


Ignore:
Timestamp:
2015-10-22T17:18:18+02:00 (8 years ago)
Author:
mathiot
Message:

ice sheet coupling : add comments, rm PRINT statements, cosmetic changes

Location:
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/CONFIG/SHARED/namelist_ref

    r5619 r5823  
    474474!----------------------------------------------------------------------- 
    475475   rn_fiscpl = 43800    ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency) 
    476    ln_hfb    = .false.  ! activate conservation module (conservation exact after a time of rn_fiscpl) 
     476   ln_hsb    = .false.  ! activate conservation module (conservation exact after a time of rn_fiscpl) 
    477477/ 
    478478!----------------------------------------------------------------------- 
    … …  
    810810   rn_smsh          =     1.    !  Smagorinsky diffusivity: = 0 - use only sheer 
    811811   rn_aht_m         =  2000.    !  upper limit or stability criteria for lateral eddy diffusivity (m2/s) 
    812 / 
    813 !----------------------------------------------------------------------- 
    814 &namtra_dmpfile    !   tracer: T & S newtonian damping 
    815 !----------------------------------------------------------------------- 
    816 !          !  file name                            ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    817 !          !                                       !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    818    sn_dmpt  = 'resto',         -1        ,'Tinit' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    '' 
    819    sn_dmps  = 'resto',         -1        ,'Sinit' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    '' 
    820812/ 
    821813!----------------------------------------------------------------------- 

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5820 r5823  
    140140      ! 2 -  Content variations ! 
    141141      ! ------------------------ ! 
     142      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 
    142143      zdiff_v2 = 0._wp 
    143144      zdiff_hc = 0._wp 
    … …  
    160161            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
    161162         END IF 
    162          z_ssh_hc = glob_sum( z2d0 )  
    163          z_ssh_sc = glob_sum( z2d1 )  
     163         z_ssh_hc = glob_sum_full( z2d0 )  
     164         z_ssh_sc = glob_sum_full( z2d1 )  
    164165      ENDIF 
    165166 
    … …  
    201202!      ENDIF 
    202203!!gm end 
    203       IF ( lk_vvl ) THEN 
    204          IF (lwp) PRINT *, 'cons heat : ', kt, zdiff_hc / zvol_tot, zdiff_sc / zvol_tot  
    205          IF (lwp) PRINT *, 'cons volu : ', kt, zdiff_v2 * 1.e-9       
    206       ELSE 
    207          IF (lwp) PRINT *, 'cons heat : ', kt, zdiff_hc1 * 1.e-20 * rau0 * rcp, zdiff_sc1 * 1.e-9 
    208          IF (lwp) PRINT *, 'cons vol  : ', kt, zdiff_v1 * 1.e-9       
    209       END IF 
    210204      IF( lk_vvl ) THEN 
    211205        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
    … …  
    269263              CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
    270264           ENDIF 
    271            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) 
     265           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    272266           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
    273267           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
    … …  
    323317           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
    324318        ENDIF 
    325         CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) 
     319        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    326320        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    327321        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5802 r5823  
    529529               WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    530530 
    531                ! set grounded point to 0 (treshold at 1cm, have to be update after first coupling experience) 
    532                WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
     531               ! set grounded point to 0  
     532               ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 
     533               WHERE ( bathy(:,:) .LE. risfdep(:,:) ) 
    533534                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    534535                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    … …  
    575576         ! patch to avoid case bathy = ice shelf draft and bathy between 0 and zhmin 
    576577         IF ( ln_isfcav ) THEN 
    577             WHERE (bathy == risfdep) 
     578            WHERE ( bathy == risfdep ) 
    578579               bathy   = 0.0_wp ; risfdep = 0.0_wp 
    579580            END WHERE 

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r5820 r5823  
    103103                  ! heat diff 
    104104                  zdtem(ji,jj) = tsn(ji,jj,jk,jp_tem) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 
    105                             - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
     105                               - tsb(ji,jj,jk,jp_tem) * pe3t_b (ji,jj,jk) * ptmask_b(ji,jj,jk) 
    106106                  ! salt diff 
    107107                  zdsal(ji,jj) = tsn(ji,jj,jk,jp_sal) * fse3t_n(ji,jj,jk) *  tmask  (ji,jj,jk)   & 

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r5790 r5823  
    1313   USE dom_oce         ! ocean space and time domain 
    1414   USE oce             ! global tra/dyn variable 
    15    USE in_out_manager  ! I/O manager 
    1615   USE lib_mpp         ! MPP library 
    1716   USE lib_fortran     ! MPP library 
    18    USE iom 
     17   USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 
    … …  
    4544      ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc ) 
    4645         ! 
    47       IF( lk_mpp              )   CALL mpp_sum ( iscpl_alloc ) 
     46      IF( lk_mpp          )   CALL mpp_sum ( iscpl_alloc ) 
    4847      IF( iscpl_alloc > 0 )   CALL ctl_warn('iscpl_alloc: allocation of arrays failed') 
    4948   END FUNCTION iscpl_alloc 

  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r5820 r5823  
    2121   USE lib_fortran     ! MPP library 
    2222   USE wrk_nemo        ! Memory allocation 
    23    USE lbclnk 
    24    USE domngb 
    25    USE sbc_ice, ONLY : lk_lim3 
    26    USE iscplini 
    27    USE iscplhsb 
     23   USE lbclnk          ! communication 
     24   USE iscplini        ! ice sheet coupling: initialisation 
     25   USE iscplhsb        ! ice sheet coupling: conservation 
    2826 
    2927   IMPLICIT NONE 
    3028   PRIVATE 
    3129    
    32    PUBLIC   iscpl_stp        
     30   PUBLIC   iscpl_stp          ! step management  
    3331   PUBLIC   iscpl_rst_interpol ! routine to wet and dry 
    3432   !! 
    … …  
    5553      REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b   
    5654      REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 
    57 !!---------------------------------------------------------------------- 
     55      !!---------------------------------------------------------------------- 
    5856      INTEGER  ::   inum0 
    5957      CHARACTER(20) :: cfile 
    … …  
    141139      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: ptmask_b, pumask_b, pvmask_b    !! mask before 
    142140      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pe3t_b  , pe3u_b  , pe3v_b      !! scale factor before 
    143       REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b 
     141      REAL(wp), DIMENSION(:,:,:  ), INTENT(in ) :: pdepw_b                         !! depth w before 
    144142      REAL(wp), DIMENSION(:,:    ), INTENT(in ) :: psmask_b                        !! mask before 
    145143      !! 
    … …  
    157155      REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d 
    158156      REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 
    159       !! 
     157 
     158      !! allocate variables 
    160159      CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   ) 
    161160      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d         )  
    … …  
    165164      CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         )  
    166165      CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, hu1, hv1               )  
     166 
    167167      !! mask value to be sure 
    168168      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 
    … …  
    182182      zsmask0(:,:) = psmask_b(:,:) 
    183183      zsmask1(:,:) = psmask_b(:,:) 
    184       DO iz = 1,10    ! need to be tuned (configuration dependent) 
     184      DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
    185185         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 
    186186         DO ji = 2,jpi-1 
    … …  
    189189               jjp1=jj+1; jjm1=jj-1; 
    190190               summsk=(zsmask0(jip1,jj)+zsmask0(jim1,jj)+zsmask0(ji,jjp1)+zsmask0(ji,jjm1)) 
    191                IF (zdsmask(ji,jj)==1 .AND. summsk .NE. 0) THEN 
     191               IF (zdsmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
    192192                  sshn(ji,jj)=( zssh0(jip1,jj)*zsmask0(jip1,jj)     & 
    193193                  &           + zssh0(jim1,jj)*zsmask0(jim1,jj)     & 
    194194                  &           + zssh0(ji,jjp1)*zsmask0(ji,jjp1)     & 
    195195                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 
    196                   zsmask1(ji,jj)=1 
     196                  zsmask1(ji,jj)=1._wp 
    197197               END IF 
    198198            END DO 
    199199         END DO 
    200          CALL lbc_lnk(sshn,'T',1.) 
    201          CALL lbc_lnk(zsmask1,'T',1.) 
     200         CALL lbc_lnk(sshn,'T',1._wp) 
     201         CALL lbc_lnk(zsmask1,'T',1._wp) 
    202202         zssh0   = sshn 
    203203         zsmask0 = zsmask1 
    … …  
    257257         END DO 
    258258 
    259          hu(:,:) = 0._wp                          ! Ocean depth at U-points 
    260          hv(:,:) = 0._wp                          ! Ocean depth at V-points 
    261          ht(:,:) = 0._wp                          ! Ocean depth at T-points 
     259      ! t-, u- and v- water column thickness 
     260      ! ------------------------------------ 
     261         ht(:,:) = 0._wp ; hu(:,:) = 0._wp ; hv(:,:) = 0._wp 
    262262         DO jk = 1, jpkm1 
    263263            hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    … …  
    272272 
    273273!============================================================================= 
    274  
    275274! compute velocity 
    276275! compute velocity in order to conserve barotropic velocity (modification by poderation of the scale factor). 
    … …  
    332331      ztmask1(:,:,:) = ptmask_b(:,:,:) 
    333332      ztmask0(:,:,:) = ptmask_b(:,:,:) 
    334       DO iz = 1,10 
     333      DO iz = 1,10 ! resolution dependent (OK for ISOMIP+ case) 
    335334          DO jk = 1,jpk-1 
    336335              zdmask=tmask(:,:,jk)-ztmask0(:,:,jk); 
    … …  
    341340                      summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk)) 
    342341                      !! horizontal basic extrapolation 
    343                       IF (zdmask(ji,jj)==1 .AND. summsk .NE. 0) THEN 
     342                      IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN 
    344343                         tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) & 
    345344                         &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) & 
    … …  
    353352                      END IF 
    354353                      !! vertical extrapolation if horizontal extra failed 
    355                       IF (zdmask(ji,jj)==1 .AND. summsk==0) THEN 
     354                      IF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN 
    356355                         jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1) 
    357356                         summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1)) 
    358                          IF (zdmask(ji,jj)==1 .AND. summsk .NE. 0 ) THEN 
     357                         IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp ) THEN 
    359358                            tsn(ji,jj,jk,1)=( zts0(ji,jj,jkp1,1)*ztmask0(ji,jj,jkp1)     & 
    360359                            &                +zts0(ji,jj,jkm1,1)*ztmask0(ji,jj,jkm1))/summsk 
    361360                            tsn(ji,jj,jk,2)=( zts0(ji,jj,jkp1,2)*ztmask0(ji,jj,jkp1)     & 
    362361                            &                +zts0(ji,jj,jkm1,2)*ztmask0(ji,jj,jkm1))/summsk 
    363                             ztmask1(ji,jj,jk)=1 
     362                            ztmask1(ji,jj,jk)=1._wp 
    364363                         END IF 
    365364                      END IF 
    … …  
    367366              END DO 
    368367          END DO 
    369           CALL lbc_lnk(tsn(:,:,:,1),'T',1.) 
    370           CALL lbc_lnk(tsn(:,:,:,2),'T',1.) 
    371           CALL lbc_lnk(ztmask1,'T',1.) 
     368           
     369          CALL lbc_lnk(tsn(:,:,:,1),'T',1._wp) 
     370          CALL lbc_lnk(tsn(:,:,:,2),'T',1._wp) 
     371          CALL lbc_lnk(ztmask1,'T',1._wp) 
     372 
     373          ! update 
    372374          zts0(:,:,:,:) = tsn(:,:,:,:) 
    373375          ztmask0 = ztmask1 
    374       END DO 
     376 
     377      END DO 
     378 
     379      ! mask new tsn field 
    375380      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 
    376381      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 
    … …  
    381386            DO jj = 1,jpj 
    382387               DO ji = 1,jpi 
    383                   IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1.0_wp .AND. (tmask(ji,jj,1)==0 .OR. ptmask_b(ji,jj,1)==0) ) THEN 
     388                  IF (zwmaskn(ji,jj,jk) * zwmaskb(ji,jj,jk) == 1._wp .AND. (tmask(ji,jj,1)==0._wp .OR. ptmask_b(ji,jj,1)==0._wp) ) THEN 
    384389                     !compute weight 
    385390                     zdzp1 = MAX(0._wp,fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk+1)) 
    386391                     zdz   =           fsdepw_n(ji,jj,jk+1) - pdepw_b(ji,jj,jk  )  
    387392                     zdzm1 = MAX(0._wp,pdepw_b(ji,jj,jk  ) - fsdepw_n(ji,jj,jk  )) 
    388                      IF (zdz .LT. 0.0_wp) THEN  
     393                     IF (zdz .LT. 0._wp) THEN  
    389394                        WRITE(numout,*) 'ERROR dz n ', ji,jj,jk,zdz,fsdepw_n(ji,jj,jk+1),fsdepw_n(ji,jj,jk),fsdepw_n(ji,jj,jk-1) 
    390395                        WRITE(numout,*) 'ERROR dz n             = ',fse3t_n (ji,jj,jk+1),fse3t_n (ji,jj,jk),fse3t_n (ji,jj,jk-1), sshn(ji,jj) 
    … …  
    411416      END IF 
    412417 
    413       ! Special value for closed pool and set the mask to 0 to run 
    414       WHERE (tmask(:,:,:) == 1.0 .AND. tsn(:,:,:,2) == 0._wp)  
    415          tsn(:,:,:,2)=  -99._wp 
    416          tmask(:,:,:) = 0.0 
    417          umask(:,:,:) = 0.0 
    418          vmask(:,:,:) = 0.0 
     418      ! closed pool 
     419      ! ----------------------------------------------------------------------------------------- 
     420      ! case we open a cell but no neigbour cells available to get an estimate of T and S 
     421      WHERE (tmask(:,:,:) == 1._wp .AND. tsn(:,:,:,2) == 0._wp)  
     422         tsn(:,:,:,2)=  -99._wp  ! Special value for closed pool (checking purpose in output.init) 
     423         tmask(:,:,:) = 0._wp    ! set mask to 0 to run 
     424         umask(:,:,:) = 0._wp 
     425         vmask(:,:,:) = 0._wp 
    419426      END WHERE 
    420  
     427       
     428      ! set mbkt and mikt to 1 in thiese location 
    421429      WHERE (SUM(tmask,dim=3) == 0) 
    422430         mbkt(:,:)=1 ; mbku(:,:)=1 ; mbkv(:,:)=1 
    423431         mikt(:,:)=1 ; miku(:,:)=1 ; mikv(:,:)=1 
    424432      END WHERE 
    425  
     433      ! ------------------------------------------------------------------------------------------- 
    426434      ! compute new tn and sn if we close cell  
    427435      ! nothing to do 
Note: See TracChangeset for help on using the changeset viewer.