Changeset 7806


Ignore:
Timestamp:
2017-03-17T08:46:30+01:00 (4 years ago)
Author:
cbricaud
Message:

phaze dev_r5003_MERCATOR6_CRS branch with rev7805 of 3.6_stable branch

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO
Files:
75 edited
2 copied

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r7256 r7806  
    212212   REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
    213213   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
     214   REAL(wp), PUBLIC ::   rn_cdsn          !: thermal conductivity of the snow [W/m/K] 
    214215   REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
    215216   REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
     
    320321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i     !: Sea-Ice Age (days) 
    321322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i    !: Sea-Ice Age times ice area (days) 
     323 
    322324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i    !: brine volume 
    323325 
     
    406408   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s]  
    407409   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s]  
     410 
    408411   ! 
    409412   !!---------------------------------------------------------------------- 
     
    463466         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     & 
    464467         &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) ,     & 
    465          &      om_i (jpi,jpj)                              , STAT=ierr(ii) ) 
     468         &      om_i (jpi,jpj) , STAT=ierr(ii) ) 
    466469      ii = ii + 1 
    467470      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5602 r7806  
    244244      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    245245      NAMELIST/namicedyn/ nn_icestr, ln_icestr_bvf, rn_pe_rdg, rn_pstar, rn_crhg, rn_cio,  rn_creepl, rn_ecc, & 
    246          &                nn_nevp, rn_relast, nn_ahi0, rn_ahi0_ref 
    247       INTEGER  ::   ji, jj 
    248       REAL(wp) ::   za00, zd_max 
     246         &                nn_nevp, rn_relast 
    249247      !!------------------------------------------------------------------- 
    250248 
     
    272270         WRITE(numout,*) '   number of iterations for subcycling                  nn_nevp       = ', nn_nevp 
    273271         WRITE(numout,*) '   ratio of elastic timescale over ice time step        rn_relast     = ', rn_relast 
    274          WRITE(numout,*) '   horizontal diffusivity calculation                   nn_ahi0       = ', nn_ahi0 
    275          WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)           rn_ahi0_ref   = ', rn_ahi0_ref 
    276272      ENDIF 
    277273      ! 
     
    279275      rhoco  = rau0  * rn_cio 
    280276      ! 
    281       !  Diffusion coefficients 
    282       SELECT CASE( nn_ahi0 ) 
    283  
    284       CASE( 0 ) 
    285          ahiu(:,:) = rn_ahi0_ref 
    286          ahiv(:,:) = rn_ahi0_ref 
    287  
    288          IF(lwp) WRITE(numout,*) '' 
    289          IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref' 
    290  
    291       CASE( 1 )  
    292  
    293          zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
    294          IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
    295           
    296          ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
    297                                                         !                    (60° = min latitude for ice cover)   
    298          ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
    299  
    300          IF(lwp) WRITE(numout,*) '' 
    301          IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 
    302          IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp  
    303           
    304       CASE( 2 )  
    305  
    306          zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
    307          IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
    308           
    309          za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
    310                                                  !                    (60° = min latitude for ice cover)   
    311          DO jj = 1, jpj 
    312             DO ji = 1, jpi 
    313                ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
    314                ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
    315             END DO 
    316          END DO 
    317          ! 
    318          IF(lwp) WRITE(numout,*) '' 
    319          IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
    320          IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
    321           
    322       END SELECT 
    323  
    324277   END SUBROUTINE lim_dyn_init 
    325278 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r7256 r7806  
    202202      ! ----------------------- 
    203203 
    204       IF(ln_ctl)   THEN 
    205          DO jk = 1 , isize 
    206             zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk) 
    207             WRITE(charout,FMT="(' lim_hdf  : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 
    208             CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout ) 
    209          END DO 
    210       ENDIF 
     204 !     IF(ln_ctl)   THEN 
     205 !        DO jk = 1 , isize 
     206 !           zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk) 
     207 !           WRITE(charout,FMT="('lim_hdf  : zconv =',D23.16, ' iter =',I4)") zconv, iter 
     208 !           CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout ) 
     209 !        END DO 
     210  !    ENDIF 
    211211      ! 
    212212      CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 
     
    233233      !!------------------------------------------------------------------- 
    234234      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    235       NAMELIST/namicehdf/ nn_convfrq  
    236       !!------------------------------------------------------------------- 
    237       ! 
    238       IF(lwp) THEN 
    239          WRITE(numout,*) 
    240          WRITE(numout,*) 'lim_hdf : Ice horizontal diffusion' 
    241          WRITE(numout,*) '~~~~~~~' 
    242       ENDIF 
     235      NAMELIST/namicehdf/  nn_ahi0, rn_ahi0_ref, nn_convfrq  
     236      INTEGER  ::   ji, jj 
     237      REAL(wp) ::   za00, zd_max 
     238      !!------------------------------------------------------------------- 
    243239      ! 
    244240      REWIND( numnam_ice_ref )              ! Namelist namicehdf in reference namelist : Ice horizontal diffusion 
     
    253249      IF(lwp) THEN                          ! control print 
    254250         WRITE(numout,*) 
    255          WRITE(numout,*)'   Namelist of ice parameters for ice horizontal diffusion computation ' 
    256          WRITE(numout,*)'      convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq 
     251         WRITE(numout,*) 'lim_hdf_init : Ice horizontal diffusion' 
     252         WRITE(numout,*) '~~~~~~~~~~~' 
     253         WRITE(numout,*) '   horizontal diffusivity calculation                          nn_ahi0      = ', nn_ahi0 
     254         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)                  rn_ahi0_ref  = ', rn_ahi0_ref 
     255         WRITE(numout,*) '   convergence check frequency of the Crant-Nicholson scheme   nn_convfrq   = ', nn_convfrq 
    257256      ENDIF 
     257      ! 
     258      !  Diffusion coefficients 
     259      SELECT CASE( nn_ahi0 ) 
     260 
     261      CASE( -1 ) 
     262         ahiu(:,:) = 0._wp 
     263         ahiv(:,:) = 0._wp 
     264 
     265         IF(lwp) WRITE(numout,*) '' 
     266         IF(lwp) WRITE(numout,*) '   No sea-ice diffusion applied' 
     267 
     268      CASE( 0 ) 
     269         ahiu(:,:) = rn_ahi0_ref 
     270         ahiv(:,:) = rn_ahi0_ref 
     271 
     272         IF(lwp) WRITE(numout,*) '' 
     273         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim constant = rn_ahi0_ref' 
     274 
     275      CASE( 1 )  
     276 
     277         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     278         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
     279          
     280         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     281                                                        !                    (60deg = min latitude for ice cover)   
     282         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     283 
     284         IF(lwp) WRITE(numout,*) '' 
     285         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to max of e1 e2 over the domain (', zd_max, ')' 
     286         IF(lwp) WRITE(numout,*) '   value for ahim = ', rn_ahi0_ref * zd_max * 1.e-05_wp  
     287          
     288      CASE( 2 )  
     289 
     290         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     291         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
     292          
     293         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     294                                                 !                    (60deg = min latitude for ice cover)   
     295         DO jj = 1, jpj 
     296            DO ji = 1, jpi 
     297               ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
     298               ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
     299            END DO 
     300         END DO 
     301         ! 
     302         IF(lwp) WRITE(numout,*) '' 
     303         IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
     304         IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
     305          
     306      END SELECT 
    258307      ! 
    259308   END SUBROUTINE lim_hdf_init 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r5602 r7806  
    108108      INTEGER ::   iter 
    109109      CHARACTER(len=15) ::   znam 
    110       CHARACTER(len=1)  ::   zchar, zchar1 
     110      CHARACTER(len=2)  ::   zchar, zchar1 
    111111      REAL(wp), POINTER, DIMENSION(:,:) :: z2d 
    112112      !!---------------------------------------------------------------------- 
     
    130130      ! Prognostic variables  
    131131      DO jl = 1, jpl  
    132          WRITE(zchar,'(I1)') jl 
    133          znam = 'v_i'//'_htc'//zchar 
     132         WRITE(zchar,'(I2)') jl 
     133         znam = 'v_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    134134         z2d(:,:) = v_i(:,:,jl) 
    135135         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    136          znam = 'v_s'//'_htc'//zchar 
     136         znam = 'v_s'//'_htc'//TRIM(ADJUSTL(zchar)) 
    137137         z2d(:,:) = v_s(:,:,jl) 
    138138         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    139          znam = 'smv_i'//'_htc'//zchar 
     139         znam = 'smv_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    140140         z2d(:,:) = smv_i(:,:,jl) 
    141141         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    142          znam = 'oa_i'//'_htc'//zchar 
     142         znam = 'oa_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    143143         z2d(:,:) = oa_i(:,:,jl) 
    144144         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    145          znam = 'a_i'//'_htc'//zchar 
     145         znam = 'a_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    146146         z2d(:,:) = a_i(:,:,jl) 
    147147         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    148          znam = 't_su'//'_htc'//zchar 
     148         znam = 't_su'//'_htc'//TRIM(ADJUSTL(zchar)) 
    149149         z2d(:,:) = t_su(:,:,jl) 
    150150         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    151       END DO 
    152  
    153       DO jl = 1, jpl  
    154          WRITE(zchar,'(I1)') jl 
    155          znam = 'tempt_sl1'//'_htc'//zchar 
     151         znam = 'tempt_sl1'//'_htc'//TRIM(ADJUSTL(zchar)) 
    156152         z2d(:,:) = e_s(:,:,1,jl) 
    157153         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    158       END DO 
    159  
    160       DO jl = 1, jpl  
    161          WRITE(zchar,'(I1)') jl 
    162154         DO jk = 1, nlay_i  
    163             WRITE(zchar1,'(I1)') jk 
    164             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
     155            WRITE(zchar1,'(I2)') jk 
     156            znam = 'tempt'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    165157            z2d(:,:) = e_i(:,:,jk,jl) 
    166158            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     
    177169 
    178170      DO jl = 1, jpl  
    179          WRITE(zchar,'(I1)') jl 
    180          znam = 'sxice'//'_htc'//zchar 
     171         WRITE(zchar,'(I2)') jl 
     172         znam = 'sxice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    181173         z2d(:,:) = sxice(:,:,jl) 
    182174         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    183          znam = 'syice'//'_htc'//zchar 
     175         znam = 'syice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    184176         z2d(:,:) = syice(:,:,jl) 
    185177         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    186          znam = 'sxxice'//'_htc'//zchar 
     178         znam = 'sxxice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    187179         z2d(:,:) = sxxice(:,:,jl) 
    188180         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    189          znam = 'syyice'//'_htc'//zchar 
     181         znam = 'syyice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    190182         z2d(:,:) = syyice(:,:,jl) 
    191183         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    192          znam = 'sxyice'//'_htc'//zchar 
     184         znam = 'sxyice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    193185         z2d(:,:) = sxyice(:,:,jl) 
    194186         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    195          znam = 'sxsn'//'_htc'//zchar 
     187         znam = 'sxsn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    196188         z2d(:,:) = sxsn(:,:,jl) 
    197189         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    198          znam = 'sysn'//'_htc'//zchar 
     190         znam = 'sysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    199191         z2d(:,:) = sysn(:,:,jl) 
    200192         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    201          znam = 'sxxsn'//'_htc'//zchar 
     193         znam = 'sxxsn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    202194         z2d(:,:) = sxxsn(:,:,jl) 
    203195         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    204          znam = 'syysn'//'_htc'//zchar 
     196         znam = 'syysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    205197         z2d(:,:) = syysn(:,:,jl) 
    206198         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    207          znam = 'sxysn'//'_htc'//zchar 
     199         znam = 'sxysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    208200         z2d(:,:) = sxysn(:,:,jl) 
    209201         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    210          znam = 'sxa'//'_htc'//zchar 
     202         znam = 'sxa'//'_htc'//TRIM(ADJUSTL(zchar)) 
    211203         z2d(:,:) = sxa(:,:,jl) 
    212204         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    213          znam = 'sya'//'_htc'//zchar 
     205         znam = 'sya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    214206         z2d(:,:) = sya(:,:,jl) 
    215207         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    216          znam = 'sxxa'//'_htc'//zchar 
     208         znam = 'sxxa'//'_htc'//TRIM(ADJUSTL(zchar)) 
    217209         z2d(:,:) = sxxa(:,:,jl) 
    218210         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    219          znam = 'syya'//'_htc'//zchar 
     211         znam = 'syya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    220212         z2d(:,:) = syya(:,:,jl) 
    221213         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    222          znam = 'sxya'//'_htc'//zchar 
     214         znam = 'sxya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    223215         z2d(:,:) = sxya(:,:,jl) 
    224216         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    225          znam = 'sxc0'//'_htc'//zchar 
     217         znam = 'sxc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    226218         z2d(:,:) = sxc0(:,:,jl) 
    227219         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    228          znam = 'syc0'//'_htc'//zchar 
     220         znam = 'syc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    229221         z2d(:,:) = syc0(:,:,jl) 
    230222         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    231          znam = 'sxxc0'//'_htc'//zchar 
     223         znam = 'sxxc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    232224         z2d(:,:) = sxxc0(:,:,jl) 
    233225         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    234          znam = 'syyc0'//'_htc'//zchar 
     226         znam = 'syyc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    235227         z2d(:,:) = syyc0(:,:,jl) 
    236228         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    237          znam = 'sxyc0'//'_htc'//zchar 
     229         znam = 'sxyc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    238230         z2d(:,:) = sxyc0(:,:,jl) 
    239231         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    240          znam = 'sxsal'//'_htc'//zchar 
     232         znam = 'sxsal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    241233         z2d(:,:) = sxsal(:,:,jl) 
    242234         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    243          znam = 'sysal'//'_htc'//zchar 
     235         znam = 'sysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    244236         z2d(:,:) = sysal(:,:,jl) 
    245237         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    246          znam = 'sxxsal'//'_htc'//zchar 
     238         znam = 'sxxsal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    247239         z2d(:,:) = sxxsal(:,:,jl) 
    248240         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    249          znam = 'syysal'//'_htc'//zchar 
     241         znam = 'syysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    250242         z2d(:,:) = syysal(:,:,jl) 
    251243         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    252          znam = 'sxysal'//'_htc'//zchar 
     244         znam = 'sxysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    253245         z2d(:,:) = sxysal(:,:,jl) 
    254246         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    255          znam = 'sxage'//'_htc'//zchar 
     247         znam = 'sxage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    256248         z2d(:,:) = sxage(:,:,jl) 
    257249         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    258          znam = 'syage'//'_htc'//zchar 
     250         znam = 'syage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    259251         z2d(:,:) = syage(:,:,jl) 
    260252         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    261          znam = 'sxxage'//'_htc'//zchar 
     253         znam = 'sxxage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    262254         z2d(:,:) = sxxage(:,:,jl) 
    263255         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    264          znam = 'syyage'//'_htc'//zchar 
     256         znam = 'syyage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    265257         z2d(:,:) = syyage(:,:,jl) 
    266258         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    267          znam = 'sxyage'//'_htc'//zchar 
     259         znam = 'sxyage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    268260         z2d(:,:) = sxyage(:,:,jl) 
    269261         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     
    277269 
    278270      DO jl = 1, jpl  
    279          WRITE(zchar,'(I1)') jl 
     271         WRITE(zchar,'(I2)') jl 
    280272         DO jk = 1, nlay_i  
    281             WRITE(zchar1,'(I1)') jk 
    282             znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
     273            WRITE(zchar1,'(I2)') jk 
     274            znam = 'sxe'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    283275            z2d(:,:) = sxe(:,:,jk,jl) 
    284276            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    285             znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
     277            znam = 'sye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    286278            z2d(:,:) = sye(:,:,jk,jl) 
    287279            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    288             znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
     280            znam = 'sxxe'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    289281            z2d(:,:) = sxxe(:,:,jk,jl) 
    290282            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    291             znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
     283            znam = 'syye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    292284            z2d(:,:) = syye(:,:,jk,jl) 
    293285            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    294             znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
     286            znam = 'sxye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    295287            z2d(:,:) = sxye(:,:,jk,jl) 
    296288            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
     
    318310      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    319311      CHARACTER(len=15) ::   znam 
    320       CHARACTER(len=1)  ::   zchar, zchar1 
     312      CHARACTER(len=2)  ::   zchar, zchar1 
    321313      INTEGER           ::   jlibalt = jprstlib 
    322314      LOGICAL           ::   llok 
     
    357349 
    358350      DO jl = 1, jpl  
    359          WRITE(zchar,'(I1)') jl 
    360          znam = 'v_i'//'_htc'//zchar 
     351         WRITE(zchar,'(I2)') jl 
     352         znam = 'v_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    361353         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    362354         v_i(:,:,jl) = z2d(:,:) 
    363          znam = 'v_s'//'_htc'//zchar 
     355         znam = 'v_s'//'_htc'//TRIM(ADJUSTL(zchar)) 
    364356         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    365357         v_s(:,:,jl) = z2d(:,:)  
    366          znam = 'smv_i'//'_htc'//zchar 
     358         znam = 'smv_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    367359         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    368360         smv_i(:,:,jl) = z2d(:,:) 
    369          znam = 'oa_i'//'_htc'//zchar 
     361         znam = 'oa_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    370362         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    371363         oa_i(:,:,jl) = z2d(:,:) 
    372          znam = 'a_i'//'_htc'//zchar 
     364         znam = 'a_i'//'_htc'//TRIM(ADJUSTL(zchar)) 
    373365         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    374366         a_i(:,:,jl) = z2d(:,:) 
    375          znam = 't_su'//'_htc'//zchar 
     367         znam = 't_su'//'_htc'//TRIM(ADJUSTL(zchar)) 
    376368         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    377369         t_su(:,:,jl) = z2d(:,:) 
    378       END DO 
    379  
    380       DO jl = 1, jpl  
    381          WRITE(zchar,'(I1)') jl 
    382          znam = 'tempt_sl1'//'_htc'//zchar 
     370         znam = 'tempt_sl1'//'_htc'//TRIM(ADJUSTL(zchar)) 
    383371         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    384372         e_s(:,:,1,jl) = z2d(:,:) 
    385       END DO 
    386  
    387       DO jl = 1, jpl  
    388          WRITE(zchar,'(I1)') jl 
    389373         DO jk = 1, nlay_i  
    390             WRITE(zchar1,'(I1)') jk 
    391             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
     374            WRITE(zchar1,'(I2)') jk 
     375            znam = 'tempt'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    392376            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    393377            e_i(:,:,jk,jl) = z2d(:,:) 
     
    404388 
    405389      DO jl = 1, jpl  
    406          WRITE(zchar,'(I1)') jl 
    407          znam = 'sxice'//'_htc'//zchar 
     390         WRITE(zchar,'(I2)') jl 
     391         znam = 'sxice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    408392         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    409393         sxice(:,:,jl) = z2d(:,:) 
    410          znam = 'syice'//'_htc'//zchar 
     394         znam = 'syice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    411395         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    412396         syice(:,:,jl) = z2d(:,:) 
    413          znam = 'sxxice'//'_htc'//zchar 
     397         znam = 'sxxice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    414398         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    415399         sxxice(:,:,jl) = z2d(:,:) 
    416          znam = 'syyice'//'_htc'//zchar 
     400         znam = 'syyice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    417401         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    418402         syyice(:,:,jl) = z2d(:,:) 
    419          znam = 'sxyice'//'_htc'//zchar 
     403         znam = 'sxyice'//'_htc'//TRIM(ADJUSTL(zchar)) 
    420404         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    421405         sxyice(:,:,jl) = z2d(:,:) 
    422          znam = 'sxsn'//'_htc'//zchar 
     406         znam = 'sxsn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    423407         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    424408         sxsn(:,:,jl) = z2d(:,:) 
    425          znam = 'sysn'//'_htc'//zchar 
     409         znam = 'sysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    426410         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    427411         sysn(:,:,jl) = z2d(:,:) 
    428          znam = 'sxxsn'//'_htc'//zchar 
     412         znam = 'sxxsn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    429413         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    430414         sxxsn(:,:,jl) = z2d(:,:) 
    431          znam = 'syysn'//'_htc'//zchar 
     415         znam = 'syysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    432416         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    433417         syysn(:,:,jl) = z2d(:,:) 
    434          znam = 'sxysn'//'_htc'//zchar 
     418         znam = 'sxysn'//'_htc'//TRIM(ADJUSTL(zchar)) 
    435419         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    436420         sxysn(:,:,jl) = z2d(:,:) 
    437          znam = 'sxa'//'_htc'//zchar 
     421         znam = 'sxa'//'_htc'//TRIM(ADJUSTL(zchar)) 
    438422         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    439423         sxa(:,:,jl) = z2d(:,:) 
    440          znam = 'sya'//'_htc'//zchar 
     424         znam = 'sya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    441425         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    442426         sya(:,:,jl) = z2d(:,:) 
    443          znam = 'sxxa'//'_htc'//zchar 
     427         znam = 'sxxa'//'_htc'//TRIM(ADJUSTL(zchar)) 
    444428         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    445429         sxxa(:,:,jl) = z2d(:,:) 
    446          znam = 'syya'//'_htc'//zchar 
     430         znam = 'syya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    447431         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    448432         syya(:,:,jl) = z2d(:,:) 
    449          znam = 'sxya'//'_htc'//zchar 
     433         znam = 'sxya'//'_htc'//TRIM(ADJUSTL(zchar)) 
    450434         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    451435         sxya(:,:,jl) = z2d(:,:) 
    452          znam = 'sxc0'//'_htc'//zchar 
     436         znam = 'sxc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    453437         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    454438         sxc0(:,:,jl) = z2d(:,:) 
    455          znam = 'syc0'//'_htc'//zchar 
     439         znam = 'syc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    456440         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    457441         syc0(:,:,jl) = z2d(:,:) 
    458          znam = 'sxxc0'//'_htc'//zchar 
     442         znam = 'sxxc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    459443         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    460444         sxxc0(:,:,jl) = z2d(:,:) 
    461          znam = 'syyc0'//'_htc'//zchar 
     445         znam = 'syyc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    462446         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    463447         syyc0(:,:,jl) = z2d(:,:) 
    464          znam = 'sxyc0'//'_htc'//zchar 
     448         znam = 'sxyc0'//'_htc'//TRIM(ADJUSTL(zchar)) 
    465449         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    466450         sxyc0(:,:,jl) = z2d(:,:) 
    467          znam = 'sxsal'//'_htc'//zchar 
     451         znam = 'sxsal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    468452         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    469453         sxsal(:,:,jl) = z2d(:,:) 
    470          znam = 'sysal'//'_htc'//zchar 
     454         znam = 'sysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    471455         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    472456         sysal(:,:,jl) = z2d(:,:) 
    473          znam = 'sxxsal'//'_htc'//zchar 
     457         znam = 'sxxsal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    474458         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    475459         sxxsal(:,:,jl) = z2d(:,:) 
    476          znam = 'syysal'//'_htc'//zchar 
     460         znam = 'syysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    477461         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    478462         syysal(:,:,jl) = z2d(:,:) 
    479          znam = 'sxysal'//'_htc'//zchar 
     463         znam = 'sxysal'//'_htc'//TRIM(ADJUSTL(zchar)) 
    480464         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    481465         sxysal(:,:,jl) = z2d(:,:) 
    482          znam = 'sxage'//'_htc'//zchar 
     466         znam = 'sxage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    483467         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    484468         sxage(:,:,jl) = z2d(:,:) 
    485          znam = 'syage'//'_htc'//zchar 
     469         znam = 'syage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    486470         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    487471         syage(:,:,jl) = z2d(:,:) 
    488          znam = 'sxxage'//'_htc'//zchar 
     472         znam = 'sxxage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    489473         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    490474         sxxage(:,:,jl) = z2d(:,:) 
    491          znam = 'syyage'//'_htc'//zchar 
     475         znam = 'syyage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    492476         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    493477         syyage(:,:,jl) = z2d(:,:) 
    494          znam = 'sxyage'//'_htc'//zchar 
     478         znam = 'sxyage'//'_htc'//TRIM(ADJUSTL(zchar)) 
    495479         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    496480         sxyage(:,:,jl)= z2d(:,:) 
     
    504488 
    505489      DO jl = 1, jpl  
    506          WRITE(zchar,'(I1)') jl 
     490         WRITE(zchar,'(I2)') jl 
    507491         DO jk = 1, nlay_i  
    508             WRITE(zchar1,'(I1)') jk 
    509             znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
     492            WRITE(zchar1,'(I2)') jk 
     493            znam = 'sxe'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    510494            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    511495            sxe(:,:,jk,jl) = z2d(:,:) 
    512             znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
     496            znam = 'sye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    513497            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    514498            sye(:,:,jk,jl) = z2d(:,:) 
    515             znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
     499            znam = 'sxxe'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    516500            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    517501            sxxe(:,:,jk,jl) = z2d(:,:) 
    518             znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
     502            znam = 'syye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    519503            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    520504            syye(:,:,jk,jl) = z2d(:,:) 
    521             znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
     505            znam = 'sxye'//'_il'//TRIM(ADJUSTL(zchar1))//'_htc'//TRIM(ADJUSTL(zchar)) 
    522506            CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    523507            sxye(:,:,jk,jl) = z2d(:,:) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r7256 r7806  
    613613         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    614614         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    615          !          
    616615      END SELECT 
    617616 
     
    633632      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    634633      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
    635          &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
    636          &                nn_monocat, ln_it_qnsice 
     634         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,         & 
     635         &                rn_cdsn, nn_monocat, ln_it_qnsice 
    637636      !!------------------------------------------------------------------- 
    638637      ! 
     
    673672         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        rn_terr_dif  = ', rn_terr_dif 
    674673         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     nn_ice_thcon = ', nn_ice_thcon 
     674         WRITE(numout,*)'      thermal conductivity of the snow                        rn_cdsn      = ', rn_cdsn 
    675675         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    676676         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r5602 r7806  
    376376 
    377377               ! Effective thickness he (zhe) 
    378                zfac     = 1._wp / ( rcdsn + zkimean ) 
    379                zratio_s = rcdsn   * zfac 
     378               zfac     = 1._wp / ( rn_cdsn + zkimean ) 
     379               zratio_s = rn_cdsn   * zfac 
    380380               zratio_i = zkimean * zfac 
    381381               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji) 
     
    400400         DO ji = kideb, kiut 
    401401            zfac                  =  1. / MAX( epsi10 , zh_s(ji) ) 
    402             zkappa_s(ji,0)        = zghe(ji) * rcdsn * zfac 
    403             zkappa_s(ji,nlay_s)   = zghe(ji) * rcdsn * zfac 
     402            zkappa_s(ji,0)        = zghe(ji) * rn_cdsn * zfac 
     403            zkappa_s(ji,nlay_s)   = zghe(ji) * rn_cdsn * zfac 
    404404         END DO 
    405405 
    406406         DO jk = 1, nlay_s-1 
    407407            DO ji = kideb , kiut 
    408                zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
     408               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rn_cdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
    409409            END DO 
    410410         END DO 
     
    422422            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac 
    423423            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac 
    424             zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / &  
    425            &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) ) 
     424            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rn_cdsn * ztcond_i(ji,0) / &  
     425           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rn_cdsn * zh_i(ji) ) ) 
    426426            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 
    427427         END DO 
     
    697697               &             ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    698698         END DO 
     699 
    699700         ! 
    700701         !-------------------------------------------------------------------------- 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r7256 r7806  
    531531         DO jj=MAX(j1,2),j2 
    532532            DO ji=MAX(i1,2),i2 
    533                uice_agr(ji,jj) = tabres(ji,jj) 
     533               u_ice_nst(ji,jj) = tabres(ji,jj) 
    534534            END DO 
    535535         END DO 
     
    582582         DO jj=MAX(j1,2),j2 
    583583            DO ji=MAX(i1,2),i2 
    584                vice_agr(ji,jj) = tabres(ji,jj) 
     584               v_ice_nst(ji,jj) = tabres(ji,jj) 
    585585            END DO 
    586586         END DO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90

    r7256 r7806  
    177177         tabres = zrhox * tabres 
    178178      ELSE 
    179          DO jj=j1,j2 
    180             DO ji=i1,i2 
     179         DO jj=MAX(j1,2),j2 
     180            DO ji=MAX(i1,2),i2 
    181181               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1)) 
    182182               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj) 
     
    202202      IF( before ) THEN 
    203203         zrhoy = Agrif_Rhoy() 
    204          DO jj=MAX(j1,2),j2 
    205             DO ji=MAX(i1,2),i2 
     204         DO jj=j1,j2 
     205            DO ji=i1,i2 
    206206               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 
    207207            END DO 
     
    209209         tabres = zrhoy * tabres 
    210210      ELSE 
    211          DO jj=MAX(j1,2),j2 
    212             DO ji=MAX(i1,2),i2 
     211         DO jj=j1,j2 
     212            DO ji=i1,i2 
    213213               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj)) 
    214214               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj) 
     
    235235      IF( before ) THEN 
    236236         zrhox = Agrif_Rhox() 
    237          DO jj=MAX(j1,2),j2 
    238             DO ji=MAX(i1,2),i2 
     237         DO jj=j1,j2 
     238            DO ji=i1,i2 
    239239               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 
    240240            END DO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r7217 r7806  
    1717   USE lib_mpp         ! distributed memory computing library 
    1818 
     19   USE iom 
    1920   USE domstp          ! domain: set the time-step 
    2021 
     
    7374 
    7475      CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     76      CALL dom_msk      ! Masks 
     77      CALL dom_hgr      ! Horizontal grid 
    7578      CALL dom_zgr      ! Vertical mesh and bathymetry option 
    76       CALL dom_grd      ! Create a domain file 
    77  
    78      ! 
    79       ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 
    80       !        but could be usefull in many other routines 
     79      ! 
    8180      e12t    (:,:) = e1t(:,:) * e2t(:,:) 
    8281      e1e2t   (:,:) = e1t(:,:) * e2t(:,:) 
     
    9190      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    9291      ! 
    93       hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
    94       hv(:,:) = 0._wp 
    95       DO jk = 1, jpk 
    96          hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    97          hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
    98       END DO 
    99       !                                        ! Inverse of the local depth 
    100       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
    101       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
    102  
    10392      CALL dom_stp      ! Time step 
    104       CALL dom_msk      ! Masks 
    10593      CALL dom_ctl      ! Domain control 
    10694 
     
    178166      nstocklist = nn_stocklist 
    179167      nwrite = nn_write 
    180  
    181  
    182168      !                             ! control of output frequency 
    183169      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     
    222208904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    223209      IF(lwm) WRITE ( numond, namdom ) 
     210 
    224211 
    225212      IF(lwp) THEN 
     
    321308   END SUBROUTINE dom_nam 
    322309 
     310   SUBROUTINE dom_msk 
     311      !!--------------------------------------------------------------------- 
     312      !!                 ***  ROUTINE dom_msk  *** 
     313      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
     314      !!      ocean mask informations and defines the interior domain T-mask. 
     315      !! 
     316      !! ** Method  :  Read in a file all the arrays generated in routines 
     317      !!               dommsk:   'mask.nc' file 
     318      !!              The interior ocean/land mask is computed from tmask 
     319      !!              setting to zero the duplicated row and lines due to 
     320      !!              MPP exchange halos, est-west cyclic and north fold 
     321      !!              boundary conditions. 
     322      !! 
     323      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point 
     324      !!               tpol     : ??? 
     325      !!---------------------------------------------------------------------- 
     326      ! 
     327      INTEGER  ::  inum   ! local integers 
     328      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     329      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     330      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     331      ! 
     332      !!--------------------------------------------------------------------- 
     333       
     334 
     335 
     336      IF(lwp) WRITE(numout,*) 
     337      IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 
     338      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     339 
     340      CALL wrk_alloc( jpi, jpj, zmbk ) 
     341      zmbk(:,:) = 0._wp 
     342 
     343      IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" ' 
     344      CALL iom_open( 'mask', inum ) 
     345 
     346         !                                                         ! masks (inum2)  
     347      CALL iom_get( inum, jpdom_data, 'tmask', tmask ) 
     348      CALL iom_get( inum, jpdom_data, 'umask', umask ) 
     349      CALL iom_get( inum, jpdom_data, 'vmask', vmask ) 
     350      CALL iom_get( inum, jpdom_data, 'fmask', fmask ) 
     351 
     352      CALL lbc_lnk( tmask, 'T', 1._wp )    ! Lateral boundary conditions 
     353      CALL lbc_lnk( umask, 'U', 1._wp )       
     354      CALL lbc_lnk( vmask, 'V', 1._wp ) 
     355      CALL lbc_lnk( fmask, 'F', 1._wp ) 
     356 
     357#if defined key_c1d 
     358      ! set umask and vmask equal tmask in 1D configuration 
     359      IF(lwp) WRITE(numout,*) 
     360      IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********' 
     361      IF(lwp) WRITE(numout,*) '**********                                                     ********' 
     362 
     363      umask(:,:,:) = tmask(:,:,:) 
     364      vmask(:,:,:) = tmask(:,:,:) 
     365#endif 
     366 
     367#if defined key_degrad 
     368      CALL iom_get( inum, jpdom_data, 'facvolt', facvol ) 
     369#endif 
     370 
     371      CALL iom_get( inum, jpdom_data, 'mbathy', zmbk )              ! number of ocean t-points 
     372      mbathy (:,:) = INT( zmbk(:,:) ) 
     373      misfdep(:,:) = 1                                               ! ice shelf case not yet done 
     374       
     375      CALL zgr_bot_level                                             ! mbk. arrays (deepest ocean t-, u- & v-points 
     376 
     377      !                                     ! ============================ 
     378      !                                     !        close the files  
     379      !                                     ! ============================ 
     380 
     381      ! 
     382      ! Interior domain mask (used for global sum) 
     383      ! -------------------- 
     384      ssmask(:,:)  = tmask(:,:,1) 
     385      tmask_i(:,:) = tmask(:,:,1) 
     386      iif = jpreci                        ! thickness of exchange halos in i-axis 
     387      iil = nlci - jpreci + 1 
     388      ijf = jprecj                        ! thickness of exchange halos in j-axis 
     389      ijl = nlcj - jprecj + 1 
     390      ! 
     391      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns 
     392      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns) 
     393      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows 
     394      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows) 
     395      ! 
     396      !                                   ! north fold mask 
     397      tpol(1:jpiglo) = 1._wp 
     398      !                                 
     399      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot 
     400      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot 
     401      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row 
     402         IF( mjg(ijl-1) == jpjglo-1 ) THEN 
     403            DO ji = iif+1, iil-1 
     404               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
     405            END DO 
     406         ENDIF 
     407      ENDIF  
     408      ! 
     409      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 
     410      ! least 1 wet u point 
     411      DO jj = 1, jpjm1 
     412         DO ji = 1, fs_jpim1   ! vector loop 
     413            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     414            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     415         END DO 
     416         DO ji = 1, jpim1      ! NO vector opt. 
     417            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     418               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
     419         END DO 
     420      END DO 
     421      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
     422      CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
     423      CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     424 
     425      ! 3. Ocean/land mask at wu-, wv- and w points  
     426      !---------------------------------------------- 
     427      wmask (:,:,1) = tmask(:,:,1) ! ???????? 
     428      wumask(:,:,1) = umask(:,:,1) ! ???????? 
     429      wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
     430      DO jk = 2, jpk 
     431         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     432         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     433         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
     434      END DO 
     435      ! 
     436      CALL wrk_dealloc( jpi, jpj, zmbk ) 
     437      ! 
     438      CALL iom_close( inum ) 
     439      ! 
     440   END SUBROUTINE dom_msk 
     441 
     442   SUBROUTINE zgr_bot_level 
     443      !!---------------------------------------------------------------------- 
     444      !!                    ***  ROUTINE zgr_bot_level  *** 
     445      !! 
     446      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays) 
     447      !! 
     448      !! ** Method  :   computes from mbathy with a minimum value of 1 over land 
     449      !! 
     450      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
     451      !!                                     ocean level at t-, u- & v-points 
     452      !!                                     (min value = 1 over land) 
     453      !!---------------------------------------------------------------------- 
     454      ! 
     455      INTEGER ::   ji, jj   ! dummy loop indices 
     456      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     457      !!---------------------------------------------------------------------- 
     458 
     459      ! 
     460      IF(lwp) WRITE(numout,*) 
     461      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels ' 
     462      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~' 
     463      ! 
     464      CALL wrk_alloc( jpi, jpj, zmbk ) 
     465      ! 
     466      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land) 
     467      mikt(:,:) = 1 ; miku(:,:) = 1; mikv(:,:) = 1; ! top k-index of T-level (=1 over open ocean; >1 beneath ice shelf) 
     468      !                                     ! bottom k-index of W-level = mbkt+1 
     469      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level 
     470         DO ji = 1, jpim1 
     471            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  ) 
     472            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
     473         END DO 
     474      END DO 
     475      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
     476      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
     477      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
     478      ! 
     479      CALL wrk_dealloc( jpi, jpj, zmbk ) 
     480      ! 
     481   END SUBROUTINE zgr_bot_level 
     482 
     483   SUBROUTINE dom_hgr 
     484      !!---------------------------------------------------------------------- 
     485      !!                  ***  ROUTINE dom_hgr  *** 
     486      !!                    
     487      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
     488      !!      ocean horizontal mesh informations  
     489      !! 
     490      !! ** Method  :   Read in a file all the arrays generated in routines 
     491      !!                domhgr:   'mesh_hgr.nc' file 
     492      !!---------------------------------------------------------------------- 
     493      !! 
     494      INTEGER ::   ji, jj   ! dummy loop indices 
     495      INTEGER  ::  inum    ! local integers 
     496      !!---------------------------------------------------------------------- 
     497 
     498      IF(lwp) WRITE(numout,*) 
     499      IF(lwp) WRITE(numout,*) 'dom_grd_hgr : read NetCDF mesh and mask information file(s)' 
     500      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     501 
     502      IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" ' 
     503      CALL iom_open( 'mesh_hgr', inum ) 
     504 
     505      !                                                         ! horizontal mesh (inum3) 
     506      CALL iom_get( inum, jpdom_data, 'glamt', glamt ) 
     507      CALL iom_get( inum, jpdom_data, 'glamu', glamu ) 
     508      CALL iom_get( inum, jpdom_data, 'glamv', glamv ) 
     509      CALL iom_get( inum, jpdom_data, 'glamf', glamf ) 
     510 
     511      CALL iom_get( inum, jpdom_data, 'gphit', gphit ) 
     512      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu ) 
     513      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv ) 
     514      CALL iom_get( inum, jpdom_data, 'gphif', gphif ) 
     515 
     516      CALL iom_get( inum, jpdom_data, 'e1t', e1t ) 
     517      CALL iom_get( inum, jpdom_data, 'e1u', e1u ) 
     518      CALL iom_get( inum, jpdom_data, 'e1v', e1v ) 
     519       
     520      CALL iom_get( inum, jpdom_data, 'e2t', e2t ) 
     521      CALL iom_get( inum, jpdom_data, 'e2u', e2u ) 
     522      CALL iom_get( inum, jpdom_data, 'e2v', e2v ) 
     523 
     524      CALL iom_get( inum, jpdom_data, 'ff', ff ) 
     525 
     526 
     527      ! Control printing : Grid informations (if not restart) 
     528      ! ---------------- 
     529 
     530      IF(lwp .AND. .NOT.ln_rstart ) THEN 
     531         WRITE(numout,*) 
     532         WRITE(numout,*) '          longitude and e1 scale factors' 
     533         WRITE(numout,*) '          ------------------------------' 
     534         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   & 
     535            glamv(ji,1), glamf(ji,1),   & 
     536            e1t(ji,1), e1u(ji,1),   & 
     537            e1v(ji,1), ji = 1, jpi,10) 
     538 
     539         WRITE(numout,*) 
     540         WRITE(numout,*) '          latitude and e2 scale factors' 
     541         WRITE(numout,*) '          -----------------------------' 
     542         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   & 
     543            &                     gphiv(1,jj), gphif(1,jj),   & 
     544            &                     e2t  (1,jj), e2u  (1,jj),   & 
     545            &                     e2v  (1,jj), jj = 1, jpj, 10 ) 
     546      ENDIF 
     547 
     548      !                                     ! ============================ 
     549      !                                     !        close the files  
     550      !                                     ! ============================ 
     551      CALL iom_close( inum ) 
     552      ! 
     5539300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
     554            f19.10, 1x, f19.10, 1x, f19.10 ) 
     555   END SUBROUTINE dom_hgr 
     556 
     557 
    323558   SUBROUTINE dom_zgr 
    324559      !!---------------------------------------------------------------------- 
    325560      !!                ***  ROUTINE dom_zgr  *** 
    326561      !!                    
    327       !! ** Purpose :  set the depth of model levels and the resulting  
    328       !!      vertical scale factors. 
     562      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
     563      !!      ocean horizontal mesh informations and/or set the depth of model levels  
     564      !!      and the resulting vertical scale factors. 
    329565      !! 
    330566      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d) 
     
    338574      !! ** Action  :   define gdep., e3., mbathy and bathy 
    339575      !!---------------------------------------------------------------------- 
    340       INTEGER ::   ioptio = 0   ! temporary integer 
    341       INTEGER ::   ios 
     576      INTEGER  ::  ioptio = 0   ! temporary integer 
     577      INTEGER  ::  inum, ios 
     578      INTEGER  ::  ji, jj, jk, ik 
     579      REAL(wp) ::  zrefdep 
    342580      !! 
    343581      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
     582      REAL(wp), POINTER, DIMENSION(:,:) :: zprt, zprw 
    344583      !!---------------------------------------------------------------------- 
    345584 
     
    372611      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' ) 
    373612 
    374    END SUBROUTINE dom_zgr 
    375  
    376    SUBROUTINE dom_ctl 
    377       !!---------------------------------------------------------------------- 
    378       !!                     ***  ROUTINE dom_ctl  *** 
    379       !! 
    380       !! ** Purpose :   Domain control. 
    381       !! 
    382       !! ** Method  :   compute and print extrema of masked scale factors 
    383       !! 
    384       !! History : 
    385       !!   8.5  !  02-08  (G. Madec)    Original code 
    386       !!---------------------------------------------------------------------- 
    387       !! * Local declarations 
    388       INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
    389       INTEGER, DIMENSION(2) ::   iloc      !  
    390       REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
    391       !!---------------------------------------------------------------------- 
    392  
    393       ! Extrema of the scale factors 
    394  
    395       IF(lwp)WRITE(numout,*) 
    396       IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    397       IF(lwp)WRITE(numout,*) '~~~~~~~' 
    398  
    399       IF (lk_mpp) THEN 
    400          CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 
    401          CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 
    402          CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 
    403          CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 
     613      IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" ' 
     614      CALL iom_open( 'mesh_zgr', inum ) 
     615 
     616      CALL iom_get( inum, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth 
     617      CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', gdepw_1d ) 
     618      IF( ln_zco .OR. ln_zps ) THEN 
     619         CALL iom_get( inum, jpdom_unknown, 'e3t_1d'  , e3t_1d   )    ! reference scale factors 
     620         CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , e3w_1d   ) 
     621      ENDIF 
     622 
     623!!gm BUG in s-coordinate this does not work! 
     624      ! deepest/shallowest W level Above/Below ~10m 
     625      zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_1d) )                 ! ref. depth with tolerance (10% of minimum layer thickness) 
     626      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 
     627      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
     628!!gm end bug 
     629 
     630      IF(lwp) THEN 
     631         WRITE(numout,*) 
     632         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:' 
     633         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" ) 
     634         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk ) 
     635      ENDIF 
     636 
     637      DO jk = 1, jpk 
     638         IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_1d or e3t_1d =< 0 ' ) 
     639         IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( ' gdepw_1d or gdept_1d < 0 ' ) 
     640      END DO 
     641 
     642      IF( lk_vvl ) THEN 
     643          CALL iom_get( inum, jpdom_data, 'e3t_0', e3t_0(:,:,:) ) 
     644          CALL iom_get( inum, jpdom_data, 'e3u_0', e3u_0(:,:,:) ) 
     645          CALL iom_get( inum, jpdom_data, 'e3v_0', e3v_0(:,:,:) ) 
     646          CALL iom_get( inum, jpdom_data, 'e3w_0', e3w_0(:,:,:) ) 
     647          CALL iom_get( inum, jpdom_data, 'gdept_0', gdept_0(:,:,:) ) 
     648          CALL iom_get( inum, jpdom_data, 'gdepw_0', gdepw_0(:,:,:) ) 
     649          ht_0(:,:) = 0.0_wp                       ! Reference ocean depth at  T-points 
     650          DO jk = 1, jpk 
     651             ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
     652          END DO 
    404653      ELSE 
    405          ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    406          ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    407          ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    408          ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
    409  
    410          iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
    411          iimi1 = iloc(1) + nimpp - 1 
    412          ijmi1 = iloc(2) + njmpp - 1 
    413          iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
    414          iimi2 = iloc(1) + nimpp - 1 
    415          ijmi2 = iloc(2) + njmpp - 1 
    416          iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
    417          iima1 = iloc(1) + nimpp - 1 
    418          ijma1 = iloc(2) + njmpp - 1 
    419          iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
    420          iima2 = iloc(1) + nimpp - 1 
    421          ijma2 = iloc(2) + njmpp - 1 
    422       ENDIF 
    423  
    424       IF(lwp) THEN 
    425          WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
    426          WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 
    427          WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 
    428          WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
    429       ENDIF 
    430  
    431    END SUBROUTINE dom_ctl 
    432  
    433    SUBROUTINE dom_grd 
    434       !!---------------------------------------------------------------------- 
    435       !!                  ***  ROUTINE dom_grd  *** 
    436       !!                    
    437       !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
    438       !!      ocean domain informations (mesh and mask arrays). This (these) 
    439       !!      file(s) is (are) used for visualisation (SAXO software) and 
    440       !!      diagnostic computation. 
    441       !! 
    442       !! ** Method  :   Read in a file all the arrays generated in routines 
    443       !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    444       !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    445       !!                    nmsh = 1  :   'mesh_mask.nc' file 
    446       !!                         = 2  :   'mesh.nc' and mask.nc' files 
    447       !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    448       !!                                  'mask.nc' files 
    449       !!      For huge size domain, use option 2 or 3 depending on your  
    450       !!      vertical coordinate. 
    451       !! 
    452       !! ** input file :  
    453       !!      meshmask.nc  : domain size, horizontal grid-point position, 
    454       !!                     masks, depth and vertical scale factors 
    455       !!---------------------------------------------------------------------- 
    456       USE iom 
    457       !! 
    458       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    459       INTEGER  ::   ik, inum0 , inum1 , inum2 , inum3 , inum4   ! local integers 
    460       REAL(wp) ::   zrefdep         ! local real 
    461       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk, zprt, zprw 
    462       !!---------------------------------------------------------------------- 
    463  
    464       IF(lwp) WRITE(numout,*) 
    465       IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 
    466       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    467  
    468       CALL wrk_alloc( jpi, jpj, zmbk, zprt, zprw ) 
    469  
    470       zmbk(:,:) = 0._wp 
    471  
    472       SELECT CASE (nmsh) 
    473          !                                     ! ============================ 
    474          CASE ( 1 )                            !  create 'mesh_mask.nc' file 
    475             !                                  ! ============================ 
    476  
    477             IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" ' 
    478             CALL iom_open( 'mesh_mask', inum0 ) 
    479  
    480             inum2 = inum0                                            ! put all the informations 
    481             inum3 = inum0                                            ! in unit inum0 
    482             inum4 = inum0 
    483  
    484             !                                  ! ============================ 
    485          CASE ( 2 )                            !  create 'mesh.nc' and  
    486             !                                  !         'mask.nc' files 
    487             !                                  ! ============================ 
    488  
    489             IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" ' 
    490             CALL iom_open( 'mesh', inum1 ) 
    491             CALL iom_open( 'mask', inum2 ) 
    492  
    493             inum3 = inum1                                            ! put mesh informations  
    494             inum4 = inum1                                            ! in unit inum1  
    495  
    496             !                                  ! ============================ 
    497          CASE ( 3 )                            !  create 'mesh_hgr.nc' 
    498             !                                  !         'mesh_zgr.nc' and 
    499             !                                  !         'mask.nc'     files 
    500             !                                  ! ============================ 
    501  
    502             IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , "mesh_zgr.nc" and "mask.nc" ' 
    503             CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc' 
    504             CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc' 
    505             CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc' 
    506  
    507             !                                  ! =========================== 
    508          CASE DEFAULT                          ! return error  
    509             !                                  ! mesh has to be provided 
    510             !                                  ! =========================== 
    511             CALL ctl_stop( ' OFFLINE mode requires the input mesh mask(s). ',   & 
    512             &                                 ' Invalid nn_msh value in the namelist (0 is not allowed)' ) 
    513  
    514          END SELECT 
    515  
    516          !                                                         ! masks (inum2)  
    517          CALL iom_get( inum2, jpdom_data, 'tmask', tmask ) 
    518          CALL iom_get( inum2, jpdom_data, 'umask', umask ) 
    519          CALL iom_get( inum2, jpdom_data, 'vmask', vmask ) 
    520          CALL iom_get( inum2, jpdom_data, 'fmask', fmask ) 
    521  
    522          CALL lbc_lnk( tmask, 'T', 1._wp )    ! Lateral boundary conditions 
    523          CALL lbc_lnk( umask, 'U', 1._wp )       
    524          CALL lbc_lnk( vmask, 'V', 1._wp ) 
    525          CALL lbc_lnk( fmask, 'F', 1._wp ) 
    526  
    527 #if defined key_c1d 
    528          ! set umask and vmask equal tmask in 1D configuration 
    529          IF(lwp) WRITE(numout,*) 
    530          IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********' 
    531          IF(lwp) WRITE(numout,*) '**********                                                     ********' 
    532  
    533          umask(:,:,:) = tmask(:,:,:) 
    534          vmask(:,:,:) = tmask(:,:,:) 
    535 #endif 
    536  
    537 #if defined key_degrad 
    538          CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 
    539 #endif 
    540  
    541          !                                                         ! horizontal mesh (inum3) 
    542          CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) 
    543          CALL iom_get( inum3, jpdom_data, 'glamu', glamu ) 
    544          CALL iom_get( inum3, jpdom_data, 'glamv', glamv ) 
    545          CALL iom_get( inum3, jpdom_data, 'glamf', glamf ) 
    546  
    547          CALL iom_get( inum3, jpdom_data, 'gphit', gphit ) 
    548          CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu ) 
    549          CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv ) 
    550          CALL iom_get( inum3, jpdom_data, 'gphif', gphif ) 
    551  
    552          CALL iom_get( inum3, jpdom_data, 'e1t', e1t ) 
    553          CALL iom_get( inum3, jpdom_data, 'e1u', e1u ) 
    554          CALL iom_get( inum3, jpdom_data, 'e1v', e1v ) 
    555           
    556          CALL iom_get( inum3, jpdom_data, 'e2t', e2t ) 
    557          CALL iom_get( inum3, jpdom_data, 'e2u', e2u ) 
    558          CALL iom_get( inum3, jpdom_data, 'e2v', e2v ) 
    559  
    560          CALL iom_get( inum3, jpdom_data, 'ff', ff ) 
    561  
    562          CALL iom_get( inum4, jpdom_data, 'mbathy', zmbk )              ! number of ocean t-points 
    563          mbathy (:,:) = INT( zmbk(:,:) ) 
    564          misfdep(:,:) = 1                                               ! ice shelf case not yet done 
    565           
    566          CALL zgr_bot_level                                             ! mbk. arrays (deepest ocean t-, u- & v-points 
    567          ! 
    568654         IF( ln_sco ) THEN                                         ! s-coordinate 
    569             CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt ) 
    570             CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu ) 
    571             CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv ) 
    572             CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf ) 
     655            CALL iom_get( inum, jpdom_data, 'hbatt', hbatt ) 
     656            CALL iom_get( inum, jpdom_data, 'hbatu', hbatu ) 
     657            CALL iom_get( inum, jpdom_data, 'hbatv', hbatv ) 
     658            CALL iom_get( inum, jpdom_data, 'hbatf', hbatf ) 
    573659             
    574             CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef. 
    575             CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw ) 
    576             CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w )  
    577             CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt ) 
    578             CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 
    579  
    580             CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors 
    581             CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
    582             CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
    583             CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
    584  
    585             CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth 
    586             CALL iom_get( inum4, jpdom_unknown, 'gdepw_1d', gdepw_1d ) 
     660            CALL iom_get( inum, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef. 
     661            CALL iom_get( inum, jpdom_unknown, 'gsigw', gsigw ) 
     662            CALL iom_get( inum, jpdom_unknown, 'gsi3w', gsi3w )  
     663            CALL iom_get( inum, jpdom_unknown, 'esigt', esigt ) 
     664            CALL iom_get( inum, jpdom_unknown, 'esigw', esigw ) 
     665 
     666            CALL iom_get( inum, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors 
     667            CALL iom_get( inum, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
     668            CALL iom_get( inum, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
     669            CALL iom_get( inum, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
    587670         ENDIF 
    588671 
    589672  
    590673         IF( ln_zps ) THEN                                           ! z-coordinate - partial steps 
    591             CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d )  ! reference depth 
    592             CALL iom_get( inum4, jpdom_unknown, 'gdepw_1d', gdepw_1d ) 
    593             CALL iom_get( inum4, jpdom_unknown, 'e3t_1d'  , e3t_1d   )    ! reference scale factors 
    594             CALL iom_get( inum4, jpdom_unknown, 'e3w_1d'  , e3w_1d   ) 
    595674            ! 
    596             IF( nmsh <= 6 ) THEN                                        ! 3D vertical scale factors 
    597                CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) 
    598                CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
    599                CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
    600                CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
     675            IF( iom_varid( inum, 'e3t_0', ldstop = .FALSE. ) > 0 ) THEN 
     676               CALL iom_get( inum, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) 
     677               CALL iom_get( inum, jpdom_data, 'e3u_0', fse3u_n(:,:,:) ) 
     678               CALL iom_get( inum, jpdom_data, 'e3v_0', fse3v_n(:,:,:) ) 
     679               CALL iom_get( inum, jpdom_data, 'e3w_0', fse3w_n(:,:,:) ) 
    601680            ELSE                                                        ! 2D bottom scale factors 
    602                CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) 
    603                CALL iom_get( inum4, jpdom_data, 'e3w_ps', e3wp ) 
     681               CALL iom_get( inum, jpdom_data, 'e3t_ps', e3tp ) 
     682               CALL iom_get( inum, jpdom_data, 'e3w_ps', e3wp ) 
    604683               !                                                        ! deduces the 3D scale factors 
    605684               DO jk = 1, jpk 
     
    633712            END IF 
    634713 
    635             IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level 
    636                CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) ) 
    637                CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) ) 
     714            IF( iom_varid( inum, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level 
     715               CALL iom_get( inum, jpdom_data, 'gdept_0', fsdept_n(:,:,:) ) 
     716               CALL iom_get( inum, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) ) 
    638717            ELSE                                                           ! 2D bottom depth 
    639                CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) 
    640                CALL iom_get( inum4, jpdom_data, 'hdepw', zprw ) 
     718               CALL wrk_alloc( jpi, jpj, zprt, zprw ) 
     719               ! 
     720               CALL iom_get( inum, jpdom_data, 'hdept', zprt ) 
     721               CALL iom_get( inum, jpdom_data, 'hdepw', zprw ) 
    641722               ! 
    642723               DO jk = 1, jpk                                              ! deduces the 3D depth 
     
    654735                  END DO 
    655736               END DO 
     737               CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    656738            ENDIF 
    657739            ! 
     
    659741 
    660742         IF( ln_zco ) THEN           ! Vertical coordinates and scales factors 
    661             CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth 
    662             CALL iom_get( inum4, jpdom_unknown, 'gdepw_1d', gdepw_1d ) 
    663             CALL iom_get( inum4, jpdom_unknown, 'e3t_1d'  , e3t_1d   ) 
    664             CALL iom_get( inum4, jpdom_unknown, 'e3w_1d'  , e3w_1d   ) 
    665743            DO jk = 1, jpk 
    666744               fse3t_n(:,:,jk) = e3t_1d(jk)                              ! set to the ref. factors 
     
    672750            END DO 
    673751         ENDIF 
    674  
    675 !!gm BUG in s-coordinate this does not work! 
    676       ! deepest/shallowest W level Above/Below ~10m 
    677       zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_1d) )                 ! ref. depth with tolerance (10% of minimum layer thickness) 
    678       nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 
    679       nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
    680 !!gm end bug 
    681  
    682       ! Control printing : Grid informations (if not restart) 
    683       ! ---------------- 
    684  
    685       IF(lwp .AND. .NOT.ln_rstart ) THEN 
    686          WRITE(numout,*) 
    687          WRITE(numout,*) '          longitude and e1 scale factors' 
    688          WRITE(numout,*) '          ------------------------------' 
    689          WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   & 
    690             glamv(ji,1), glamf(ji,1),   & 
    691             e1t(ji,1), e1u(ji,1),   & 
    692             e1v(ji,1), ji = 1, jpi,10) 
    693 9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    694             f19.10, 1x, f19.10, 1x, f19.10 ) 
    695  
    696          WRITE(numout,*) 
    697          WRITE(numout,*) '          latitude and e2 scale factors' 
    698          WRITE(numout,*) '          -----------------------------' 
    699          WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   & 
    700             &                     gphiv(1,jj), gphif(1,jj),   & 
    701             &                     e2t  (1,jj), e2u  (1,jj),   & 
    702             &                     e2v  (1,jj), jj = 1, jpj, 10 ) 
    703       ENDIF 
    704  
    705  
    706       IF( nprint == 1 .AND. lwp ) THEN 
    707          WRITE(numout,*) '          e1u e2u ' 
    708          CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    709          CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    710          WRITE(numout,*) '          e1v e2v  ' 
    711          CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    712          CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    713       ENDIF 
    714  
    715       IF(lwp) THEN 
    716          WRITE(numout,*) 
    717          WRITE(numout,*) '              Reference z-coordinate depth and scale factors:' 
    718          WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" ) 
    719          WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk ) 
    720       ENDIF 
    721  
    722       DO jk = 1, jpk 
    723          IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_1d or e3t_1d =< 0 ' ) 
    724          IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( ' gdepw_1d or gdept_1d < 0 ' ) 
    725       END DO 
     752         ! 
     753      ENDIF 
    726754      !                                     ! ============================ 
    727755      !                                     !        close the files  
    728756      !                                     ! ============================ 
    729       SELECT CASE ( nmsh ) 
    730          CASE ( 1 )                 
    731             CALL iom_close( inum0 ) 
    732          CASE ( 2 ) 
    733             CALL iom_close( inum1 ) 
    734             CALL iom_close( inum2 ) 
    735          CASE ( 3 ) 
    736             CALL iom_close( inum2 ) 
    737             CALL iom_close( inum3 ) 
    738             CALL iom_close( inum4 ) 
    739       END SELECT 
    740       ! 
    741       CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 
    742       ! 
    743    END SUBROUTINE dom_grd 
    744  
    745  
    746    SUBROUTINE zgr_bot_level 
    747       !!---------------------------------------------------------------------- 
    748       !!                    ***  ROUTINE zgr_bot_level  *** 
    749       !! 
    750       !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays) 
    751       !! 
    752       !! ** Method  :   computes from mbathy with a minimum value of 1 over land 
    753       !! 
    754       !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
    755       !!                                     ocean level at t-, u- & v-points 
    756       !!                                     (min value = 1 over land) 
    757       !!---------------------------------------------------------------------- 
    758       ! 
    759       INTEGER ::   ji, jj   ! dummy loop indices 
    760       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
    761       !!---------------------------------------------------------------------- 
    762  
    763       ! 
    764       IF(lwp) WRITE(numout,*) 
    765       IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels ' 
    766       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~' 
    767       ! 
    768       CALL wrk_alloc( jpi, jpj, zmbk ) 
    769       ! 
    770       mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land) 
    771       mikt(:,:) = 1 ; miku(:,:) = 1; mikv(:,:) = 1; ! top k-index of T-level (=1 over open ocean; >1 beneath ice shelf) 
    772       !                                     ! bottom k-index of W-level = mbkt+1 
    773       DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level 
    774          DO ji = 1, jpim1 
    775             mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  ) 
    776             mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
    777          END DO 
    778       END DO 
    779       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    780       zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    781       zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    782       ! 
    783       CALL wrk_dealloc( jpi, jpj, zmbk ) 
    784       ! 
    785    END SUBROUTINE zgr_bot_level 
    786  
    787    SUBROUTINE dom_msk 
    788       !!--------------------------------------------------------------------- 
    789       !!                 ***  ROUTINE dom_msk  *** 
    790       !! 
    791       !! ** Purpose :   Off-line case: defines the interior domain T-mask. 
    792       !! 
    793       !! ** Method  :   The interior ocean/land mask is computed from tmask 
    794       !!              setting to zero the duplicated row and lines due to 
    795       !!              MPP exchange halos, est-west cyclic and north fold 
    796       !!              boundary conditions. 
    797       !! 
    798       !! ** Action :   tmask_i  : interiorland/ocean mask at t-point 
    799       !!               tpol     : ??? 
    800       !!---------------------------------------------------------------------- 
    801       ! 
    802       INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    803       INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
    804       INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
    805       ! 
    806       !!--------------------------------------------------------------------- 
    807        
    808       CALL wrk_alloc( jpi, jpj, imsk ) 
    809       ! 
    810       ! Interior domain mask (used for global sum) 
    811       ! -------------------- 
    812       ssmask(:,:)  = tmask(:,:,1) 
    813       tmask_i(:,:) = tmask(:,:,1) 
    814       iif = jpreci                        ! thickness of exchange halos in i-axis 
    815       iil = nlci - jpreci + 1 
    816       ijf = jprecj                        ! thickness of exchange halos in j-axis 
    817       ijl = nlcj - jprecj + 1 
    818       ! 
    819       tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns 
    820       tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns) 
    821       tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows 
    822       tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows) 
    823       ! 
    824       !                                   ! north fold mask 
    825       tpol(1:jpiglo) = 1._wp 
    826       !                                 
    827       IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot 
    828       IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot 
    829       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row 
    830          IF( mjg(ijl-1) == jpjglo-1 ) THEN 
    831             DO ji = iif+1, iil-1 
    832                tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
    833             END DO 
    834          ENDIF 
    835       ENDIF  
    836       ! 
    837       ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 
    838       ! least 1 wet u point 
    839       DO jj = 1, jpjm1 
    840          DO ji = 1, fs_jpim1   ! vector loop 
    841             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    842             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    843          END DO 
    844          DO ji = 1, jpim1      ! NO vector opt. 
    845             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    846                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    847          END DO 
    848       END DO 
    849       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    850       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    851       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
    852  
    853       ! 3. Ocean/land mask at wu-, wv- and w points  
    854       !---------------------------------------------- 
    855       wmask (:,:,1) = tmask(:,:,1) ! ???????? 
    856       wumask(:,:,1) = umask(:,:,1) ! ???????? 
    857       wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
    858       DO jk=2,jpk 
    859          wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 
    860          wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)    
    861          wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 
    862       END DO 
    863       ! 
    864       IF( nprint == 1 .AND. lwp ) THEN    ! Control print 
    865          imsk(:,:) = INT( tmask_i(:,:) ) 
    866          WRITE(numout,*) ' tmask_i : ' 
    867          CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
    868          WRITE (numout,*) 
    869          WRITE (numout,*) ' dommsk: tmask for each level' 
    870          WRITE (numout,*) ' ----------------------------' 
    871          DO jk = 1, jpk 
    872             imsk(:,:) = INT( tmask(:,:,jk) ) 
    873             WRITE(numout,*) 
    874             WRITE(numout,*) ' level = ',jk 
    875             CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
    876          END DO 
    877       ENDIF 
    878       ! 
    879       CALL wrk_dealloc( jpi, jpj, imsk ) 
    880       ! 
    881    END SUBROUTINE dom_msk 
     757      CALL iom_close( inum ) 
     758      ! 
     759      ! 
     760   END SUBROUTINE dom_zgr 
     761 
     762   SUBROUTINE dom_ctl 
     763      !!---------------------------------------------------------------------- 
     764      !!                     ***  ROUTINE dom_ctl  *** 
     765      !! 
     766      !! ** Purpose :   Domain control. 
     767      !! 
     768      !! ** Method  :   compute and print extrema of masked scale factors 
     769      !! 
     770      !! History : 
     771      !!   8.5  !  02-08  (G. Madec)    Original code 
     772      !!---------------------------------------------------------------------- 
     773      !! * Local declarations 
     774      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
     775      INTEGER, DIMENSION(2) ::   iloc      !  
     776      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
     777      !!---------------------------------------------------------------------- 
     778 
     779      ! Extrema of the scale factors 
     780 
     781      IF(lwp)WRITE(numout,*) 
     782      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
     783      IF(lwp)WRITE(numout,*) '~~~~~~~' 
     784 
     785      IF (lk_mpp) THEN 
     786         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 
     787         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 
     788         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 
     789         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 
     790      ELSE 
     791         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     792         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     793         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     794         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     795 
     796         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     797         iimi1 = iloc(1) + nimpp - 1 
     798         ijmi1 = iloc(2) + njmpp - 1 
     799         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     800         iimi2 = iloc(1) + nimpp - 1 
     801         ijmi2 = iloc(2) + njmpp - 1 
     802         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     803         iima1 = iloc(1) + nimpp - 1 
     804         ijma1 = iloc(2) + njmpp - 1 
     805         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     806         iima2 = iloc(1) + nimpp - 1 
     807         ijma2 = iloc(2) + njmpp - 1 
     808      ENDIF 
     809 
     810      IF(lwp) THEN 
     811         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
     812         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 
     813         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 
     814         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
     815      ENDIF 
     816 
     817   END SUBROUTINE dom_ctl 
    882818 
    883819   !!====================================================================== 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r7256 r7806  
    2222   USE c1d             ! 1D configuration: lk_c1d 
    2323   USE dom_oce         ! ocean domain: variables 
     24   USE domvvl          ! variable volume 
    2425   USE zdf_oce         ! ocean vertical physics: variables 
    2526   USE sbc_oce         ! surface module: variables 
     
    2829   USE trabbl          ! active tracer: bottom boundary layer 
    2930   USE ldfslp          ! lateral diffusion: iso-neutral slopes 
     31   USE sbcrnf          ! river runoffs 
    3032   USE ldfeiv          ! eddy induced velocity coef.  
    3133   USE ldftra_oce      ! ocean tracer   lateral physics 
     
    3941   USE prtctl          ! print control 
    4042   USE fldread         ! read input fields  
     43   USE wrk_nemo        ! Memory allocation  
    4144   USE timing          ! Timing 
     45   USE trc, ONLY : ln_rsttr, numrtr, numrtw, lrst_trc 
    4246 
    4347   IMPLICIT NONE 
     
    4650   PUBLIC   dta_dyn_init   ! called by opa.F90 
    4751   PUBLIC   dta_dyn        ! called by step.F90 
    48  
    49    CHARACTER(len=100) ::   cn_dir       !: Root directory for location of ssr files 
    50    LOGICAL            ::   ln_dynwzv    !: vertical velocity read in a file (T) or computed from u/v (F) 
    51    LOGICAL            ::   ln_dynbbl    !: bbl coef read in a file (T) or computed (F) 
    52    LOGICAL            ::   ln_degrad    !: degradation option enabled or not 
    53    LOGICAL            ::   ln_dynrnf    !: read runoff data in file (T) or set to zero (F) 
    54  
    55    INTEGER  , PARAMETER ::   jpfld = 21     ! maximum number of fields to read 
     52   PUBLIC   dta_dyn_swp   ! called by step.F90 
     53 
     54   CHARACTER(len=100) ::   cn_dir           !: Root directory for location of ssr files 
     55   LOGICAL            ::   ln_ssh_ini       !: initial ssh from dyn file (T) or not (F) - ssh is then read from passive tracer restart 
     56   LOGICAL            ::   ln_dynrnf        !: read runoff data in file (T) or set to zero (F) 
     57   LOGICAL            ::   ln_dynrnf_depth  !: read runoff data in file (T) or set to zero (F) 
     58   REAL(wp)           ::   fwbcorr 
     59 
     60 
     61   INTEGER  , PARAMETER ::   jpfld = 20     ! maximum number of fields to read 
    5662   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    5763   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    58    INTEGER  , SAVE      ::   jf_uwd         ! index of u-wind 
    59    INTEGER  , SAVE      ::   jf_vwd         ! index of v-wind 
    60    INTEGER  , SAVE      ::   jf_wwd         ! index of w-wind 
     64   INTEGER  , SAVE      ::   jf_uwd         ! index of u-transport 
     65   INTEGER  , SAVE      ::   jf_vwd         ! index of v-transport 
     66   INTEGER  , SAVE      ::   jf_wwd         ! index of v-transport 
    6167   INTEGER  , SAVE      ::   jf_avt         ! index of Kz 
    6268   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht 
    6369   INTEGER  , SAVE      ::   jf_emp         ! index of water flux 
     70   INTEGER  , SAVE      ::   jf_empb        ! index of water flux 
    6471   INTEGER  , SAVE      ::   jf_qsr         ! index of solar radiation 
    6572   INTEGER  , SAVE      ::   jf_wnd         ! index of wind speed 
    6673   INTEGER  , SAVE      ::   jf_ice         ! index of sea ice cover 
    6774   INTEGER  , SAVE      ::   jf_rnf         ! index of river runoff 
     75   INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux 
    6876   INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef 
    6977   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef 
    70    INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef 
    71    INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef  
    72    INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef 
    73    INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv 
    74    INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv 
    75    INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv 
    76    INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux 
    77  
    78    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
     78   INTEGER  , SAVE      ::   jf_div         ! index of e3t 
     79 
     80 
     81   TYPE(FLD), ALLOCATABLE, SAVE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
    7982   !                                               !  
    80    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at 2 time step 
    81    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) :: wnow       ! vertical velocity at 2 time step 
    8283   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
    8384   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
    8485   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes 
    8586   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes 
    86    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: uslpnow    ! zonal isopycnal slopes 
    87    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: vslpnow    ! meridional isopycnal slopes 
    88    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpinow   ! zonal diapycnal slopes 
    89    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpjnow   ! meridional diapycnal slopes 
    90  
    91    INTEGER :: nrecprev_tem , nrecprev_uwd 
     87 
     88   INTEGER, SAVE  :: nprevrec, nsecdyn 
    9289 
    9390   !! * Substitutions 
     
    113110      !!---------------------------------------------------------------------- 
    114111      ! 
    115       USE oce, ONLY:  zts    => tsa  
    116       USE oce, ONLY:  zuslp  => ua   , zvslp  => va 
    117       USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn 
    118       USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb 
    119       ! 
     112      USE oce, ONLY:  zhdivtr => ua 
    120113      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    121       ! 
    122       INTEGER  ::   ji, jj     ! dummy loop indices 
    123       INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
    124       REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    125       REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    126       INTEGER  ::   iswap_tem, iswap_uwd    !  
     114      INTEGER             ::   ji, jj, jk 
     115      REAL(wp), POINTER, DIMENSION(:,:)   :: zemp 
     116      ! 
    127117      !!---------------------------------------------------------------------- 
    128118       
     
    130120      IF( nn_timing == 1 )  CALL timing_start( 'dta_dyn') 
    131121      ! 
    132       isecsbc = nsec_year + nsec1jan000  
    133       ! 
    134       IF( kt == nit000 ) THEN 
    135          nrecprev_tem = 0 
    136          nrecprev_uwd = 0 
    137          ! 
    138          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    139          ! 
    140          IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
    141             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
    142             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
    143             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
    144             CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    145             uslpdta (:,:,:,1) = zuslp (:,:,:)  
    146             vslpdta (:,:,:,1) = zvslp (:,:,:)  
    147             wslpidta(:,:,:,1) = zwslpi(:,:,:)  
    148             wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
    149          ENDIF 
    150          IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint )  THEN    ! compute vertical velocity from u/v 
    151             zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1) 
    152             zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1) 
    153             CALL dta_dyn_wzv( zu, zv, zw ) 
    154             wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:) 
    155          ENDIF 
    156       ELSE 
    157          nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2) 
    158          nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2) 
    159          ! 
    160          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    161          ! 
    162       ENDIF 
    163       !  
    164       IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
    165          iswap_tem = 0 
    166          IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1 
    167          IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
    168             IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
    169             IF( sf_dyn(jf_tem)%ln_tint ) THEN                 ! time interpolation of data 
    170                IF( kt /= nit000 ) THEN 
    171                   uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
    172                   vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)   
    173                   wslpidta(:,:,:,1) =  wslpidta(:,:,:,2)  
    174                   wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
    175                ENDIF 
    176                ! 
    177                zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
    178                zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    179                avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
    180                CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    181                ! 
    182                uslpdta (:,:,:,2) = zuslp (:,:,:)  
    183                vslpdta (:,:,:,2) = zvslp (:,:,:)  
    184                wslpidta(:,:,:,2) = zwslpi(:,:,:)  
    185                wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
    186             ELSE 
    187                zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) 
    188                zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) 
    189                avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) 
    190                CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    191                uslpnow (:,:,:)   = zuslp (:,:,:)  
    192                vslpnow (:,:,:)   = zvslp (:,:,:)  
    193                wslpinow(:,:,:)   = zwslpi(:,:,:)  
    194                wslpjnow(:,:,:)   = zwslpj(:,:,:)  
    195             ENDIF 
    196          ENDIF 
    197          IF( sf_dyn(jf_tem)%ln_tint )  THEN 
    198             ztinta =  REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
    199                &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
    200             ztintb =  1. - ztinta 
    201             uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)   
    202             vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)   
    203             wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)   
    204             wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)   
    205          ELSE 
    206             uslp (:,:,:) = uslpnow (:,:,:) 
    207             vslp (:,:,:) = vslpnow (:,:,:) 
    208             wslpi(:,:,:) = wslpinow(:,:,:) 
    209             wslpj(:,:,:) = wslpjnow(:,:,:) 
    210          ENDIF 
    211       ENDIF 
    212       ! 
    213       IF( ln_dynwzv )  THEN    ! compute vertical velocity from u/v 
    214          iswap_uwd = 0 
    215          IF(  kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 )  iswap_uwd = 1 
    216          IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
    217             IF(lwp) WRITE(numout,*) ' Compute new vertical velocity at kt = ', kt 
    218             IF(lwp) WRITE(numout,*) 
    219             IF( sf_dyn(jf_uwd)%ln_tint ) THEN                 ! time interpolation of data 
    220                IF( kt /= nit000 )  THEN 
    221                   wdta(:,:,:,1) =  wdta(:,:,:,2)     ! swap the data for initialisation 
    222                ENDIF 
    223                zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2) 
    224                zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2) 
    225                CALL dta_dyn_wzv( zu, zv, zw ) 
    226                wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
    227             ELSE 
    228                zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:)  
    229                zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) 
    230                CALL dta_dyn_wzv( zu, zv, zw ) 
    231                wnow(:,:,:)  = zw(:,:,:) * tmask(:,:,:) 
    232             ENDIF 
    233          ENDIF 
    234          IF( sf_dyn(jf_uwd)%ln_tint )  THEN 
    235             ztinta =  REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp )  & 
    236                &    / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp ) 
    237             ztintb =  1. - ztinta 
    238             wn(:,:,:) = ztintb * wdta(:,:,:,1)  + ztinta * wdta(:,:,:,2)   
    239          ELSE 
    240             wn(:,:,:) = wnow(:,:,:) 
    241          ENDIF 
    242       ENDIF 
     122      ! 
     123      nsecdyn = nsec_year + nsec1jan000   ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     124      ! 
     125      IF( kt == nit000 ) THEN    ;    nprevrec = 0 
     126      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2) 
     127      ENDIF 
     128      ! 
     129      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
     130      ! 
     131      IF( lk_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt )    ! Computation of slopes 
    243132      ! 
    244133      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature 
    245134      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity 
    246       ! 
     135      wndm(:,:)         = sf_dyn(jf_wnd)%fnow(:,:,1)  * tmask(:,:,1)    ! wind speed - needed for gas exchange 
     136      fmmflx(:,:)       = sf_dyn(jf_fmf)%fnow(:,:,1)  * tmask(:,:,1)    ! downward salt flux (v3.5+) 
     137      fr_i(:,:)         = sf_dyn(jf_ice)%fnow(:,:,1)  * tmask(:,:,1)    ! Sea-ice fraction 
     138      qsr (:,:)         = sf_dyn(jf_qsr)%fnow(:,:,1)  * tmask(:,:,1)    ! solar radiation 
     139      emp (:,:)         = sf_dyn(jf_emp)%fnow(:,:,1)  * tmask(:,:,1)    ! E-P 
     140      IF( ln_dynrnf ) THEN  
     141         rnf (:,:)      = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     142         IF( ln_dynrnf_depth .AND. lk_vvl )    CALL  dta_dyn_hrnf 
     143      ENDIF 
     144      ! 
     145      un(:,:,:)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport 
     146      vn(:,:,:)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport 
     147      wn(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport 
     148      ! 
     149      IF( lk_vvl ) THEN 
     150         CALL wrk_alloc(jpi, jpj, zemp ) 
     151         zhdivtr(:,:,:)    = sf_dyn(jf_div)%fnow(:,:,:)  * tmask(:,:,:)    ! effective u-transport 
     152         emp_b (:,:)       = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     153         zemp(:,:) = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1) 
     154         CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, fse3t_a(:,:,:) )  !=  ssh, vertical scale factor & vertical transport 
     155         CALL wrk_dealloc(jpi, jpj, zemp ) 
     156         !                                           Write in the tracer restart file 
     157         !                                          ******************************* 
     158         IF( lrst_trc ) THEN 
     159            IF(lwp) WRITE(numout,*) 
     160            IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file ',   & 
     161               &                    'at it= ', kt,' date= ', ndastp 
     162            IF(lwp) WRITE(numout,*) '~~~~' 
     163            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha ) 
     164            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn ) 
     165         ENDIF 
     166      ENDIF 
    247167      ! 
    248168      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 
     
    251171 
    252172      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
    253       CALL zdf_mxl( kt )                                                   ! In any case, we need mxl  
    254       ! 
    255       avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:)  * tmask(:,:,:)    ! vertical diffusive coefficient  
    256       un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:)  * umask(:,:,:)    ! u-velocity 
    257       vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:)  * vmask(:,:,:)    ! v-velocity  
    258       IF( .NOT.ln_dynwzv ) &                                          ! w-velocity read in file  
    259          wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)     
    260       hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
    261       wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
    262       emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    263       fmmflx(:,:)      = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1)    ! downward salt flux (v3.5+) 
    264       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction 
    265       qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
    266       IF( ln_dynrnf ) & 
    267       rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs  
    268  
    269       !                                                      ! bbl diffusive coef 
     173      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl 
     174      ! 
     175      hmld(:,:)         = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
     176      avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient  
     177      ! 
    270178#if defined key_trabbl && ! defined key_c1d 
    271       IF( ln_dynbbl ) THEN                                        ! read in a file 
    272          ahu_bbl(:,:)  = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1) 
    273          ahv_bbl(:,:)  = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1) 
    274       ELSE                                                        ! Compute bbl coefficients if needed 
    275          tsb(:,:,:,:) = tsn(:,:,:,:) 
    276          CALL bbl( kt, nit000, 'TRC') 
    277       END IF 
     179      ahu_bbl(:,:)      = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)    ! bbl diffusive coef 
     180      ahv_bbl(:,:)      = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1) 
    278181#endif 
    279 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d  
    280       aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv 
    281       !                                                           ! Computes the horizontal values from the vertical value 
    282       DO jj = 2, jpjm1 
    283          DO ji = fs_2, fs_jpim1   ! vector opt. 
    284             aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points 
    285             aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points 
    286          END DO 
    287       END DO 
    288       CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
    289 #endif 
    290        
    291 #if defined key_degrad && ! defined key_c1d  
    292       !                                          ! degrad option : diffusive and eiv coef are 3D 
    293       ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:) 
    294       ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:) 
    295       ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:) 
    296 #  if defined key_traldf_eiv  
    297       aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:) 
    298       aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:) 
    299       aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:) 
    300 #  endif 
    301 #endif 
     182      ! 
     183      ! 
     184      CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 
    302185      ! 
    303186      IF(ln_ctl) THEN                  ! print control 
     
    308191         CALL prt_ctl(tab3d_1=wn               , clinfo1=' wn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    309192         CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    310          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
    311          CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
    312          CALL prt_ctl(tab2d_1=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask, ovlap=1 ) 
    313          CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask, ovlap=1 ) 
    314          CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
    315          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
     193!         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
     194!         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
     195!         CALL prt_ctl(tab2d_1=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask, ovlap=1 ) 
     196!         CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask, ovlap=1 ) 
     197!         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
     198!         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
    316199      ENDIF 
    317200      ! 
     
    335218      INTEGER  :: inum, idv, idimv                   ! local integer 
    336219      INTEGER  :: ios                                ! Local integer output status for namelist read 
    337       !! 
    338       CHARACTER(len=100)            ::  cn_dir   !   Root directory for location of core files 
    339       TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read 
    340       TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf  ! informations about the fields to be read 
    341       TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 " 
    342       TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf  !   "                                 " 
    343       !!---------------------------------------------------------------------- 
    344       ! 
    345       NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf,    & 
    346          &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf,  & 
    347          &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          & 
    348          &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf 
     220      INTEGER  :: ji, jj, jk 
     221      REAL(wp) :: zcoef 
     222      INTEGER  :: nkrnf_max 
     223      REAL(wp) :: hrnf_max 
     224      !! 
     225      CHARACTER(len=100)            ::  cn_dir        !   Root directory for location of core files 
     226      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d         ! array of namelist informations on the fields to read 
     227      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_empb, sn_emp  ! informations about the fields to be read 
     228      TYPE(FLD_N) :: sn_tem , sn_sal , sn_avt   !   "                 " 
     229      TYPE(FLD_N) :: sn_mld, sn_qsr, sn_wnd , sn_ice , sn_fmf   !   "               " 
     230      TYPE(FLD_N) :: sn_ubl, sn_vbl, sn_rnf    !   "              " 
     231      TYPE(FLD_N) :: sn_div  ! informations about the fields to be read 
     232      !!---------------------------------------------------------------------- 
     233 
     234      NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth,  ln_ssh_ini, fwbcorr, & 
     235         &                sn_uwd, sn_vwd, sn_wwd, sn_emp,    & 
     236         &                sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr ,   & 
     237         &                sn_wnd, sn_ice, sn_fmf,                    & 
     238         &                sn_ubl, sn_vbl, sn_rnf,                   & 
     239         &                sn_empb, sn_div  
    349240      ! 
    350241      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
     
    363254         WRITE(numout,*) '~~~~~~~ ' 
    364255         WRITE(numout,*) '   Namelist namdta_dyn' 
    365          WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv 
    366          WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl 
    367          WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad 
    368          WRITE(numout,*) '      river runoff option enabled (T) or not (F)           ln_dynrnf  = ', ln_dynrnf 
     256         WRITE(numout,*) '      ssh initialised from dyn file (T) or not (F)     ln_ssh_ini       = ', ln_ssh_ini 
     257         WRITE(numout,*) '      runoffs option enabled (T) or not (F)            ln_dynrnf        = ', ln_dynrnf 
     258         WRITE(numout,*) '      runoffs is spread in vertical                    ln_dynrnf_depth  = ', ln_dynrnf_depth 
     259         WRITE(numout,*) '      annual global mean of empmr for ssh correction   fwbcorr          = ', fwbcorr 
    369260         WRITE(numout,*) 
    370261      ENDIF 
    371262      !  
    372       IF( ln_degrad .AND. .NOT.lk_degrad ) THEN 
    373          CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' ) 
    374          ln_degrad = .FALSE. 
    375       ENDIF 
    376       IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 
    377          CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 
    378          ln_dynbbl = .FALSE. 
    379       ENDIF 
    380  
    381       jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_fmf  = 5   ;  jf_ice = 6   ;   jf_qsr = 7 
    382       jf_wnd = 8   ;   jf_uwd = 9   ;  jf_vwd = 10  ;  jf_wwd = 11  ;   jf_avt  = 12  ;  jfld  = jf_avt 
    383       ! 
    384       slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld 
    385       slf_d(jf_emp) = sn_emp   ;   slf_d(jf_fmf ) = sn_fmf   ;   slf_d(jf_ice) = sn_ice  
    386       slf_d(jf_qsr) = sn_qsr   ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_avt) = sn_avt  
    387       slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
    388  
     263 
     264      jf_uwd  = 1     ;   jf_vwd  = 2    ;   jf_wwd = 3    ;   jf_emp = 4    ;   jf_avt = 5 
     265      jf_tem  = 6     ;   jf_sal  = 7    ;   jf_mld = 8    ;   jf_qsr = 9 
     266      jf_wnd  = 10    ;   jf_ice  = 11   ;   jf_fmf = 12   ;   jfld   = jf_fmf 
     267 
     268      ! 
     269      slf_d(jf_uwd)  = sn_uwd    ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
     270      slf_d(jf_emp)  = sn_emp    ;   slf_d(jf_avt)  = sn_avt 
     271      slf_d(jf_tem)  = sn_tem    ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld 
     272      slf_d(jf_qsr)  = sn_qsr    ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_ice) = sn_ice 
     273      slf_d(jf_fmf)  = sn_fmf 
     274 
     275 
     276      ! 
     277      IF( lk_vvl ) THEN 
     278                 jf_div  = jfld + 1    ;         jf_empb  = jfld + 2      ;      jfld = jf_empb 
     279           slf_d(jf_div) = sn_div      ;   slf_d(jf_empb) = sn_empb 
     280      ENDIF 
     281      ! 
     282      IF( lk_trabbl ) THEN 
     283                 jf_ubl  = jfld + 1    ;         jf_vbl  = jfld + 2       ;      jfld = jf_vbl 
     284           slf_d(jf_ubl) = sn_ubl      ;   slf_d(jf_vbl) = sn_vbl 
     285      ENDIF 
    389286      ! 
    390287      IF( ln_dynrnf ) THEN 
    391                 jf_rnf = jfld + 1  ;  jfld  = jf_rnf 
    392          slf_d(jf_rnf) = sn_rnf 
     288                jf_rnf  = jfld + 1     ;     jfld  = jf_rnf 
     289          slf_d(jf_rnf) = sn_rnf     
    393290      ELSE 
    394          rnf (:,:) = 0._wp 
    395       ENDIF 
    396  
    397       ! 
    398       IF( .NOT.ln_degrad ) THEN     ! no degrad option 
    399          IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl 
    400                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;        jf_eiw  = jfld + 3   ;   jfld = jf_eiw 
    401            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw 
    402          ENDIF 
    403          IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl 
    404                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl 
    405            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    406          ENDIF 
    407          IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl 
    408            jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw 
    409          ENDIF 
    410       ELSE 
    411               jf_ahu  = jfld + 1 ;        jf_ahv  = jfld + 2 ;        jf_ahw  = jfld + 3  ;  jfld = jf_ahw 
    412         slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw 
    413         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl 
    414                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ; 
    415            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    416                  jf_eiu  = jfld + 3 ;        jf_eiv  = jfld + 4 ;    jf_eiw  = jfld + 5   ;  jfld = jf_eiw  
    417            slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw 
    418         ENDIF 
    419         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl 
    420                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl 
    421            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    422         ENDIF 
    423         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl 
    424                  jf_eiu  = jfld + 1 ;         jf_eiv  = jfld + 2 ;    jf_eiw  = jfld + 3   ; jfld = jf_eiw  
    425            slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw 
    426         ENDIF 
    427       ENDIF 
     291         rnf(:,:) = 0._wp 
     292      ENDIF 
     293 
    428294   
    429295      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
    430       IF( ierr > 0 ) THEN 
     296      IF( ierr > 0 )  THEN 
    431297         CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN 
    432298      ENDIF 
    433299      !                                         ! fill sf with slf_i and control print 
    434300      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 
     301      ! 
    435302      ! Open file for each variable to get his number of dimension 
    436303      DO ifpr = 1, jfld 
     
    456323            ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    457324            &         wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 ) 
    458          ELSE 
    459             ALLOCATE( uslpnow (jpi,jpj,jpk)  , vslpnow (jpi,jpj,jpk)  ,    & 
    460             &         wslpinow(jpi,jpj,jpk)  , wslpjnow(jpi,jpj,jpk)  , STAT=ierr2 ) 
    461          ENDIF  
    462          IF( ierr2 > 0 ) THEN 
    463             CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN 
     325            ! 
     326            IF( ierr2 > 0 )  THEN 
     327               CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN 
     328            ENDIF 
    464329         ENDIF 
    465330      ENDIF 
    466       IF( ln_dynwzv ) THEN                  ! slopes  
    467          IF( sf_dyn(jf_uwd)%ln_tint ) THEN      ! time interpolation 
    468             ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 ) 
    469          ELSE 
    470             ALLOCATE( wnow(jpi,jpj,jpk)  , STAT=ierr3 ) 
    471          ENDIF  
    472          IF( ierr3 > 0 ) THEN 
    473             CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' )   ;   RETURN 
    474          ENDIF 
    475       ENDIF 
    476       ! 
    477       CALL dta_dyn( nit000 ) 
    478       ! 
    479    END SUBROUTINE dta_dyn_init 
    480  
    481    SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 
    482       !!---------------------------------------------------------------------- 
    483       !!                    ***  ROUTINE wzv  *** 
    484       !! 
    485       !! ** Purpose :   Compute the now vertical velocity after the array swap 
    486       !! 
    487       !! ** Method  : - compute the now divergence given by : 
    488       !!         * z-coordinate ONLY !!!! 
    489       !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ] 
    490       !!     - Using the incompressibility hypothesis, the vertical 
    491       !!      velocity is computed by integrating the horizontal divergence 
    492       !!      from the bottom to the surface. 
    493       !!        The boundary conditions are w=0 at the bottom (no flux). 
    494       !!---------------------------------------------------------------------- 
    495       USE oce, ONLY:  zhdiv => hdivn 
    496       ! 
    497       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
    498       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  vertical velocity 
    499       !! 
    500       INTEGER  ::  ji, jj, jk 
    501       REAL(wp) ::  zu, zu1, zv, zv1, zet 
    502       !!---------------------------------------------------------------------- 
    503       ! 
    504       ! Computation of vertical velocity using horizontal divergence 
    505       zhdiv(:,:,:) = 0._wp 
    506       DO jk = 1, jpkm1 
    507          DO jj = 2, jpjm1 
    508             DO ji = fs_2, fs_jpim1   ! vector opt. 
    509                zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) 
    510                zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) 
    511                zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) 
    512                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    513                zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    514                zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
     331      ! 
     332      IF( lk_vvl ) THEN 
     333        IF( ln_ssh_ini ) THEN                     ! Restart: read in restart file 
     334           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the dynamics restart file for initialisation' 
     335           CALL iom_open( 'restart', inum ) 
     336           CALL iom_get( inum, jpdom_autoglo, 'sshn', sshn(:,:)   ) 
     337           CALL iom_get( inum, jpdom_autoglo, 'sshb', sshb(:,:)   ) 
     338           CALL iom_close( inum )                                        ! close file 
     339        ELSE 
     340           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in passive tracers restart file for initialisation' 
     341           CALL iom_get( numrtr, jpdom_autoglo, 'sshn', sshn(:,:)   ) 
     342           CALL iom_get( numrtr, jpdom_autoglo, 'sshb', sshb(:,:)   ) 
     343        ENDIF 
     344        ! 
     345        DO jk = 1, jpkm1 
     346           fse3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
     347        ENDDO 
     348        fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 
     349 
     350        ! Horizontal scale factor interpolations 
     351        ! -------------------------------------- 
     352        CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
     353        CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
     354 
     355        ! Vertical scale factor interpolations 
     356        ! ------------------------------------ 
     357        CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n(:,:,:), 'W' ) 
     358   
     359        fse3t_b(:,:,:)  = fse3t_n(:,:,:) 
     360        fse3u_b(:,:,:)  = fse3u_n(:,:,:) 
     361        fse3v_b(:,:,:)  = fse3v_n(:,:,:) 
     362 
     363        ! t- and w- points depth 
     364        ! ---------------------- 
     365        fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
     366        fsdepw_n(:,:,1) = 0.0_wp 
     367 
     368        DO jk = 2, jpk 
     369           DO jj = 1,jpj 
     370              DO ji = 1,jpi 
     371                !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere 
     372                !    tmask = wmask, ie everywhere expect at jk = mikt 
     373                                                                   ! 1 for jk = 
     374                                                                   ! mikt 
     375                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     376                 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
     377                 fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  & 
     378                     &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)) 
     379              END DO 
     380           END DO 
     381        END DO 
     382 
     383        fsdept_b(:,:,:) = fsdept_n(:,:,:) 
     384        fsdepw_b(:,:,:) = fsdepw_n(:,:,:) 
     385        ! 
     386      ENDIF 
     387      ! 
     388      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed 
     389         IF(lwp) WRITE(numout,*)  
     390         IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 
     391         CALL iom_open ( "runoffs", inum )                           ! open file 
     392         CALL iom_get  ( inum, jpdom_data, 'rodepth', h_rnf )   ! read the river mouth array 
     393         CALL iom_close( inum )                                        ! close file 
     394         ! 
     395         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     396         DO jj = 1, jpj 
     397            DO ji = 1, jpi 
     398               IF( h_rnf(ji,jj) > 0._wp ) THEN 
     399                  jk = 2 
     400                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
     401                  END DO 
     402                  nk_rnf(ji,jj) = jk 
     403               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     404               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     405               ELSE 
     406                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     407                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
     408               ENDIF 
    515409            END DO 
    516410         END DO 
     411         DO jj = 1, jpj                                ! set the associated depth 
     412            DO ji = 1, jpi 
     413               h_rnf(ji,jj) = 0._wp 
     414               DO jk = 1, nk_rnf(ji,jj) 
     415                  h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 
     416               END DO 
     417            END DO 
     418         END DO 
     419      ELSE                                       ! runoffs applied at the surface 
     420         nk_rnf(:,:) = 1 
     421         h_rnf (:,:) = fse3t(:,:,1) 
     422      ENDIF 
     423      nkrnf_max = MAXVAL( nk_rnf(:,:) ) 
     424      hrnf_max = MAXVAL( h_rnf(:,:) ) 
     425      IF( lk_mpp )  THEN 
     426         CALL mpp_max( nkrnf_max )                 ! max over the  global domain 
     427         CALL mpp_max( hrnf_max )                 ! max over the  global domain 
     428      ENDIF 
     429      IF(lwp) WRITE(numout,*) ' ' 
     430      IF(lwp) WRITE(numout,*) ' max depht of runoff : ', hrnf_max,'    max level  : ', nkrnf_max 
     431      IF(lwp) WRITE(numout,*) ' ' 
     432      ! 
     433      CALL dta_dyn( nit000 ) 
     434      ! 
     435   END SUBROUTINE dta_dyn_init 
     436 
     437   SUBROUTINE dta_dyn_swp( kt ) 
     438     !!--------------------------------------------------------------------- 
     439      !!                    ***  ROUTINE dta_dyn_swp  *** 
     440      !! 
     441      !! ** Purpose : Swap and the data and compute the vertical scale factor at U/V/W point 
     442      !!              and the depht 
     443      !! 
     444      !!--------------------------------------------------------------------- 
     445      INTEGER, INTENT(in) :: kt       ! time step 
     446      INTEGER             :: ji, jj, jk 
     447      REAL(wp)            :: zcoef 
     448      ! 
     449      !!--------------------------------------------------------------------- 
     450 
     451      IF( kt == nit000 ) THEN 
     452         IF(lwp) WRITE(numout,*) 
     453         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height' 
     454         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     455      ENDIF 
     456 
     457      sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))  ! before <-- now filtered 
     458      sshn(:,:) = ssha(:,:) 
     459 
     460      fse3t_n(:,:,:) = fse3t_a(:,:,:) 
     461 
     462      ! Reconstruction of all vertical scale factors at now and before time steps 
     463      ! ============================================================================= 
     464 
     465      ! Horizontal scale factor interpolations 
     466      ! -------------------------------------- 
     467      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 
     468      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 
     469 
     470      ! Vertical scale factor interpolations 
     471      ! ------------------------------------ 
     472      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 
     473 
     474      fse3t_b(:,:,:)  = fse3t_n(:,:,:) 
     475      fse3u_b(:,:,:)  = fse3u_n(:,:,:) 
     476      fse3v_b(:,:,:)  = fse3v_n(:,:,:) 
     477 
     478      ! t- and w- points depth 
     479      ! ---------------------- 
     480      fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 
     481      fsdepw_n(:,:,1) = 0.0_wp 
     482 
     483      DO jk = 2, jpk 
     484         DO jj = 1,jpj 
     485            DO ji = 1,jpi 
     486                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     487                 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
     488                 fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  & 
     489                     &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)) 
     490              END DO 
     491           END DO 
     492        END DO 
     493 
     494      fsdept_b(:,:,:) = fsdept_n(:,:,:) 
     495      fsdepw_b(:,:,:) = fsdepw_n(:,:,:) 
     496 
     497      ! 
     498   END SUBROUTINE dta_dyn_swp 
     499 
     500   SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta ) 
     501      !!---------------------------------------------------------------------- 
     502      !!                ***  ROUTINE dta_dyn_wzv  *** 
     503      !!                    
     504      !! ** Purpose :   compute the after ssh (ssha) and the now vertical velocity 
     505      !! 
     506      !! ** Method  : Using the incompressibility hypothesis,  
     507      !!        - the ssh increment is computed by integrating the horizontal divergence  
     508      !!          and multiply by the time step. 
     509      !! 
     510      !!        - compute the after scale factor : repartition of ssh INCREMENT proportionnaly 
     511      !!                                           to the level thickness ( z-star case ) 
     512      !! 
     513      !!        - the vertical velocity is computed by integrating the horizontal divergence   
     514      !!          from the bottom to the surface minus the scale factor evolution. 
     515      !!          The boundary conditions are w=0 at the bottom (no flux) 
     516      !! 
     517      !! ** action  :   ssha / e3t_a / wn 
     518      !! 
     519      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
     520      !!---------------------------------------------------------------------- 
     521      !! * Arguments 
     522      INTEGER,                                   INTENT(in )    :: kt        !  time-step 
     523      REAL(wp), DIMENSION(jpi,jpj,jpk)          , INTENT(in )   :: phdivtr   ! horizontal divergence transport 
     524      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: psshb     ! now ssh 
     525      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: pemp      ! evaporation minus precipitation 
     526      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(inout) :: pssha     ! after ssh 
     527      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out)   :: pe3ta     ! after vertical scale factor 
     528      !! * Local declarations 
     529      INTEGER                       :: jk 
     530      REAL(wp), DIMENSION(jpi,jpj)  :: zhdiv   
     531      REAL(wp)  :: z2dt   
     532      !!---------------------------------------------------------------------- 
     533       
     534      ! 
     535      z2dt = 2._wp * rdt 
     536      ! 
     537      zhdiv(:,:) = 0._wp 
     538      DO jk = 1, jpkm1 
     539         zhdiv(:,:) = zhdiv(:,:) +  phdivtr(:,:,jk) * tmask(:,:,jk) 
    517540      END DO 
    518       CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
    519       ! 
    520       ! computation of vertical velocity from the bottom 
    521       pw(:,:,jpk) = 0._wp 
    522       DO jk = jpkm1, 1, -1 
    523          pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 
     541      !                                                ! Sea surface  elevation time-stepping 
     542      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:) 
     543      !                                                 !  
     544      !                                                 ! After acale factors at t-points ( z_star coordinate ) 
     545      DO jk = 1, jpkm1 
     546        pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
    524547      END DO 
    525548      ! 
    526    END SUBROUTINE dta_dyn_wzv 
    527  
    528    SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
     549   END SUBROUTINE dta_dyn_ssh 
     550 
     551 
     552   SUBROUTINE dta_dyn_hrnf 
     553      !!---------------------------------------------------------------------- 
     554      !!                  ***  ROUTINE sbc_rnf  *** 
     555      !! 
     556      !! ** Purpose :   update the horizontal divergence with the runoff inflow 
     557      !! 
     558      !! ** Method  : 
     559      !!                CAUTION : rnf is positive (inflow) decreasing the 
     560      !!                          divergence and expressed in m/s 
     561      !! 
     562      !! ** Action  :   phdivn   decreased by the runoff inflow 
     563      !!---------------------------------------------------------------------- 
     564      !! 
     565      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     566      !!---------------------------------------------------------------------- 
     567      ! 
     568      DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
     569         DO ji = 1, jpi 
     570            h_rnf(ji,jj) = 0._wp 
     571            DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 
     572                h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
     573            END DO 
     574        END DO 
     575      END DO 
     576      ! 
     577   END SUBROUTINE dta_dyn_hrnf 
     578 
     579 
     580 
     581   SUBROUTINE dta_dyn_slp( kt ) 
     582      !!--------------------------------------------------------------------- 
     583      !!                    ***  ROUTINE dta_dyn_slp  *** 
     584      !! 
     585      !! ** Purpose : Computation of slope 
     586      !! 
     587      !!--------------------------------------------------------------------- 
     588      USE oce, ONLY:  zts => tsa  
     589      ! 
     590      INTEGER,  INTENT(in) :: kt       ! time step 
     591      ! 
     592      INTEGER  ::   ji, jj     ! dummy loop indices 
     593      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
     594      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
     595      INTEGER  ::   iswap 
     596      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuslp, zvslp, zwslpi, zwslpj 
     597      !!--------------------------------------------------------------------- 
     598      ! 
     599      CALL wrk_alloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj ) 
     600      ! 
     601      IF( sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
     602         IF( kt == nit000 ) THEN 
     603            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
     604            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
     605            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
     606            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     607            uslpdta (:,:,:,1) = zuslp (:,:,:)  
     608            vslpdta (:,:,:,1) = zvslp (:,:,:)  
     609            wslpidta(:,:,:,1) = zwslpi(:,:,:)  
     610            wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
     611            ! 
     612            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
     613            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
     614            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     615            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     616            uslpdta (:,:,:,2) = zuslp (:,:,:)  
     617            vslpdta (:,:,:,2) = zvslp (:,:,:)  
     618            wslpidta(:,:,:,2) = zwslpi(:,:,:)  
     619            wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
     620         ELSE 
     621           !  
     622           iswap = 0 
     623           IF( sf_dyn(jf_tem)%nrec_a(2) - nprevrec /= 0 )  iswap = 1 
     624           IF( nsecdyn > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap == 1 )  THEN    ! read/update the after data 
     625              IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
     626              uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
     627              vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)   
     628              wslpidta(:,:,:,1) =  wslpidta(:,:,:,2)  
     629              wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
     630              ! 
     631              zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
     632              zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
     633              avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     634              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     635              ! 
     636              uslpdta (:,:,:,2) = zuslp (:,:,:)  
     637              vslpdta (:,:,:,2) = zvslp (:,:,:)  
     638              wslpidta(:,:,:,2) = zwslpi(:,:,:)  
     639              wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
     640            ENDIF 
     641         ENDIF 
     642      ENDIF 
     643      ! 
     644      IF( sf_dyn(jf_tem)%ln_tint )  THEN 
     645         ztinta =  REAL( nsecdyn - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
     646            &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
     647         ztintb =  1. - ztinta 
     648#if defined key_ldfslp && ! defined key_c1d 
     649         uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)   
     650         vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)   
     651         wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)   
     652         wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)   
     653#endif 
     654      ELSE 
     655         zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)   ! temperature 
     656         zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)   ! salinity  
     657         avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)   ! vertical diffusive coef. 
     658         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     659         ! 
     660#if defined key_ldfslp && ! defined key_c1d 
     661         uslp (:,:,:) = zuslp (:,:,:) 
     662         vslp (:,:,:) = zvslp (:,:,:) 
     663         wslpi(:,:,:) = zwslpi(:,:,:) 
     664         wslpj(:,:,:) = zwslpj(:,:,:) 
     665#endif 
     666      ENDIF 
     667      ! 
     668      CALL wrk_dealloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj ) 
     669      ! 
     670   END SUBROUTINE dta_dyn_slp 
     671 
     672   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
    529673      !!--------------------------------------------------------------------- 
    530674      !!                    ***  ROUTINE dta_dyn_slp  *** 
     
    568712#endif 
    569713      ! 
    570    END SUBROUTINE dta_dyn_slp 
     714   END SUBROUTINE compute_slopes 
     715 
    571716   !!====================================================================== 
    572717END MODULE dtadyn 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5602 r7806  
    3434   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3535   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    36    !              ! I/O & MPP 
     36   !                   ! I/O & MPP 
    3737   USE iom             ! I/O library 
    3838   USE in_out_manager  ! I/O manager 
     
    5050   USE trcnam 
    5151   USE trcrst 
    52    USE diaptr         ! Need to initialise this as some variables are used in if statements later 
    5352 
    5453   IMPLICIT NONE 
     
    9493      istp = nit000 
    9594      !  
    96       CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    97       !  
    9895      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
    9996         ! 
    100          IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init) 
    101                                 CALL iom_setkt( istp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp 
    102                                 CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields 
    103                                 CALL trc_stp  ( istp )         ! time-stepping 
    104                                 CALL stp_ctl  ( istp, indic )  ! Time loop: control and print 
     97         IF( istp == nit000 )  CALL iom_init( cxios_context )            ! iom_put initialization 
     98         IF( istp /= nit000 )   CALL day        ( istp )         ! Calendar (day was already called at nit000 in day_init) 
     99                                CALL iom_setkt  ( istp - nit000 + 1, cxios_context )   ! say to iom that we are at time step kstp 
     100                                CALL trc_rst_opn( istp )         ! Open tracer                                !   restart file 
     101                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields 
     102                                CALL trc_stp    ( istp )         ! time-stepping 
     103         IF( lk_vvl )           CALL dta_dyn_swp( istp )         ! swap of sea surface height and vertical scale factors 
     104                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
    105105         istp = istp + 1 
    106106         IF( lk_mpp )   CALL mpp_max( nstop ) 
     
    265265      IF( nn_timing == 1 )  CALL timing_start( 'nemo_init') 
    266266      ! 
    267                             CALL     phy_cst    ! Physical constants 
    268                             CALL     eos_init   ! Equation of state 
    269       IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    270                             CALL     dom_cfg    ! Domain configuration 
     267                            CALL  phy_cst    ! Physical constants 
     268                            CALL  eos_init   ! Equation of state 
     269      IF( lk_c1d        )   CALL  c1d_init   ! 1D column configuration 
     270                            CALL  dom_cfg    ! Domain configuration 
     271      ! 
    271272      ! 
    272273      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist 
    273274      ! 
    274       IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
    275       ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask 
     275      IF( llexist )  THEN ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
     276      ELSE                ;  CALL  dom_rea    !  read grid from the meskmask 
    276277      ENDIF 
    277278                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    278279 
    279       IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
    280  
    281       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
     280      IF( ln_nnogather )    CALL  nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined) 
     281 
     282      IF( ln_ctl       )    CALL prt_ctl_init   ! Print control 
    282283 
    283284                            CALL     sbc_init   ! Forcings : surface module 
     
    289290 
    290291                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    291       IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
     292      IF( lk_trabbl      CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    292293 
    293294                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
    294295                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    295296                            CALL dta_dyn_init   ! Initialization for the dynamics 
    296  
    297297                            CALL     trc_init   ! Passive tracers initialization 
    298                             CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
    299298      !                                         ! in various advection and diffusion routines 
    300299      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7256 r7806  
    2424   USE phycst         ! physical constant 
    2525   USE in_out_manager  ! I/O manager 
     26   USE zdfddm 
     27   USE zdf_oce 
    2628 
    2729   IMPLICIT NONE 
     
    4244   !! * Substitutions 
    4345#  include "domzgr_substitute.h90" 
     46#  include "zdfddm_substitute.h90" 
    4447   !!---------------------------------------------------------------------- 
    4548   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    7578      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    7679      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 
     80      REAL(wp) ::   zaw, zbw, zrw 
    7781      ! 
    7882      REAL(wp), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
     83      REAL(wp), POINTER, DIMENSION(:,:)     :: pe                         ! 2D workspace  
    7984      REAL(wp), POINTER, DIMENSION(:,:,:)   :: zrhd , zrhop               ! 3D workspace 
    8085      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8186      !!-------------------------------------------------------------------- 
    8287      IF( nn_timing == 1 )   CALL timing_start('dia_ar5') 
     88 
     89      !Call to init moved to here so that we can call iom_use in the 
     90      !initialisation 
     91      IF( kt == nit000 )     CALL dia_ar5_init 
    8392  
    84       CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     93      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    8594      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    8695      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     
    95104      CALL iom_put( 'voltot', zvol               ) 
    96105      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
     106      CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
    97107 
    98108      !                      
    99       ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    100       ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    101       CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    102       ! 
    103       zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    104       DO jk = 1, jpkm1 
    105          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    106       END DO 
    107       IF( .NOT.lk_vvl ) THEN 
    108          IF ( ln_isfcav ) THEN 
    109             DO ji=1,jpi 
    110                DO jj=1,jpj 
    111                   zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     109      IF( iom_use('sshthster')) THEN 
     110         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     111         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
     112         CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial salinity 
     113         ! 
     114         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     115         DO jk = 1, jpkm1 
     116            zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
     117         END DO 
     118         IF( .NOT.lk_vvl ) THEN 
     119            IF ( ln_isfcav ) THEN 
     120               DO ji=1,jpi 
     121                  DO jj=1,jpj 
     122                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     123                  END DO 
    112124               END DO 
    113             END DO 
    114          ELSE 
    115             zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     125            ELSE 
     126               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     127            END IF 
    116128         END IF 
    117       END IF 
    118129      !                                          
    119       zarho = SUM( area(:,:) * zbotpres(:,:) )  
    120       IF( lk_mpp )   CALL mpp_sum( zarho ) 
    121       zssh_steric = - zarho / area_tot 
    122       CALL iom_put( 'sshthster', zssh_steric ) 
    123        
     130         zarho = SUM( area(:,:) * zbotpres(:,:) )  
     131         IF( lk_mpp )   CALL mpp_sum( zarho ) 
     132         zssh_steric = - zarho / area_tot 
     133         CALL iom_put( 'sshthster', zssh_steric ) 
     134      ENDIF 
    124135      !                                         ! steric sea surface height 
    125136      CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) )                 ! now in situ and potential density 
     
    190201      CALL iom_put( 'temptot', ztemp ) 
    191202      CALL iom_put( 'saltot' , zsal  ) 
    192       ! 
    193       CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres ) 
     203 
     204      IF( iom_use( 'tnpeo' )) THEN     
     205      ! Work done against stratification by vertical mixing 
     206      ! Exclude points where rn2 is negative as convection kicks in here and 
     207      ! work is not being done against stratification 
     208          pe(:,:) = 0._wp 
     209          IF( lk_zdfddm ) THEN 
     210             DO ji=1,jpi 
     211                DO jj=1,jpj 
     212                   DO jk=1,jpk 
     213                      zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   & 
     214                         &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
     215                      ! 
     216                      zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     217                      zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     218                      ! 
     219                      pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 
     220                           &       grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )  & 
     221                           &       - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 
     222 
     223                   ENDDO 
     224                ENDDO 
     225             ENDDO 
     226          ELSE 
     227             DO ji=1,jpi 
     228                DO jj=1,jpj 
     229                   DO jk=1,jpk 
     230                       pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 
     231                   ENDDO 
     232                ENDDO 
     233             ENDDO 
     234          ENDIF 
     235          CALL lbc_lnk(pe, 'T', 1._wp)          
     236          CALL iom_put( 'tnpeo', pe ) 
     237      ENDIF 
     238      ! 
     239      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres, pe ) 
    194240      CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    195241      CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     
    232278      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    233279 
    234       CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
    235       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
    236       CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
    237       CALL iom_close( inum ) 
    238  
    239       sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    240       sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    241       IF( ln_zps ) THEN               ! z-coord. partial steps 
    242          DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    243             DO ji = 1, jpi 
    244                ik = mbkt(ji,jj) 
    245                IF( ik > 1 ) THEN 
    246                   zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    247                   sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    248                ENDIF 
     280      IF( iom_use('sshthster')) THEN 
     281         CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
     282         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     283         CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
     284         CALL iom_close( inum ) 
     285 
     286         sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     287         sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     288         IF( ln_zps ) THEN               ! z-coord. partial steps 
     289            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     290               DO ji = 1, jpi 
     291                  ik = mbkt(ji,jj) 
     292                  IF( ik > 1 ) THEN 
     293                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     294                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     295                  ENDIF 
     296               END DO 
    249297            END DO 
    250          END DO 
     298         ENDIF 
    251299      ENDIF 
    252300      ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r5602 r7806  
    99   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation 
    1010   !!            3.6  ! 2014-12  (C. Ethe) use of IOM 
     11   !!            3.6  ! 2016-06  (T. Graham) Addition of diagnostics for CMIP6 
    1112   !!---------------------------------------------------------------------- 
    1213 
     
    2122   USE dom_oce          ! ocean space and time domain 
    2223   USE phycst           ! physical constants 
     24   USE ldftra_oce  
    2325   ! 
    2426   USE iom              ! IOM library 
     
    3840   PUBLIC   dia_ptr_init   ! call in step module 
    3941   PUBLIC   dia_ptr        ! call in step module 
     42   PUBLIC   dia_ptr_ohst_components        ! called from tra_ldf/tra_adv routines 
    4043 
    4144   !                                  !!** namelist  namptr  ** 
    42    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
    43    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    44     
     45   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv, htr_vt   !: Heat TRansports (adv, diff, Bolus.) 
     46   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv, str_vs   !: Salt TRansports (adv, diff, Bolus.) 
     47   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_ove, str_ove   !: heat Salt TRansports ( overturn.) 
     48   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_btr, str_btr   !: heat Salt TRansports ( barotropic ) 
    4549 
    4650   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    4751   LOGICAL, PUBLIC ::   ln_subbas   !  Atlantic/Pacific/Indian basins calculation 
    48    INTEGER        ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
     52   INTEGER, PUBLIC ::   nptr        ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T)  
    4953 
    5054   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
     
    6569   !!---------------------------------------------------------------------- 
    6670   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    67    !! $Id$  
     71   !! $Id$ 
    6872   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6973   !!---------------------------------------------------------------------- 
     
    7781      ! 
    7882      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    79       REAL(wp) ::   zv, zsfc               ! local scalar 
     83      REAL(wp) ::   zsfc,zvfc               ! local scalar 
    8084      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d   ! 2D workspace 
    8185      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  z3d   ! 3D workspace 
    8286      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zmask   ! 3D workspace 
    8387      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::  zts   ! 3D workspace 
    84       CHARACTER( len = 10 )  :: cl1 
     88      REAL(wp), DIMENSION(jpj)     ::  vsum   ! 1D workspace 
     89      REAL(wp), DIMENSION(jpj,jpts)     ::  tssum   ! 1D workspace 
     90  
     91      ! 
     92      !overturning calculation 
     93      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   sjk  , r1_sjk ! i-mean i-k-surface and its inverse 
     94      REAL(wp), DIMENSION(jpj,jpk,nptr) ::   v_msf, sn_jk  , tn_jk ! i-mean T and S, j-Stream-Function 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zvn   ! 3D workspace 
     96 
     97 
     98      CHARACTER( len = 12 )  :: cl1 
    8599      !!---------------------------------------------------------------------- 
    86100      ! 
     
    111125            END DO 
    112126         ENDIF 
     127         IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     128            ! define fields multiplied by scalar 
     129            zmask(:,:,:) = 0._wp 
     130            zts(:,:,:,:) = 0._wp 
     131            zvn(:,:,:) = 0._wp 
     132            DO jk = 1, jpkm1 
     133               DO jj = 1, jpjm1 
     134                  DO ji = 1, jpi 
     135                     zvfc = e1v(ji,jj) * fse3v(ji,jj,jk) 
     136                     zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     137                     zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     138                     zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 
     139                     zvn(ji,jj,jk)        = vn(ji,jj,jk)         * zvfc 
     140                  ENDDO 
     141               ENDDO 
     142             ENDDO 
     143         ENDIF 
     144         IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 
     145             sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 
     146             r1_sjk(:,:,1) = 0._wp 
     147             WHERE( sjk(:,:,1) /= 0._wp )   r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 
     148 
     149             ! i-mean T and S, j-Stream-Function, global 
     150             tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 
     151             sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 
     152             v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 
     153 
     154             htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 
     155             str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 
     156 
     157             z2d(1,:) = htr_ove(:,1) * rc_pwatt        !  (conversion in PW) 
     158             DO ji = 1, jpi 
     159               z2d(ji,:) = z2d(1,:) 
     160             ENDDO 
     161             cl1 = 'sophtove' 
     162             CALL iom_put( TRIM(cl1), z2d ) 
     163             z2d(1,:) = str_ove(:,1) * rc_ggram        !  (conversion in Gg) 
     164             DO ji = 1, jpi 
     165               z2d(ji,:) = z2d(1,:) 
     166             ENDDO 
     167             cl1 = 'sopstove' 
     168             CALL iom_put( TRIM(cl1), z2d ) 
     169             IF( ln_subbas ) THEN 
     170                DO jn = 2, nptr 
     171                    sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 
     172                    r1_sjk(:,:,jn) = 0._wp 
     173                    WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 
     174 
     175                    ! i-mean T and S, j-Stream-Function, basin 
     176                    tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     177                    sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     178                    v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )  
     179                    htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 
     180                    str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 
     181 
     182                    z2d(1,:) = htr_ove(:,jn) * rc_pwatt !  (conversion in PW) 
     183                    DO ji = 1, jpi 
     184                        z2d(ji,:) = z2d(1,:) 
     185                    ENDDO 
     186                    cl1 = TRIM('sophtove_'//clsubb(jn)) 
     187                    CALL iom_put( cl1, z2d ) 
     188                    z2d(1,:) = str_ove(:,jn) * rc_ggram        ! (conversion in Gg) 
     189                    DO ji = 1, jpi 
     190                        z2d(ji,:) = z2d(1,:) 
     191                    ENDDO 
     192                    cl1 = TRIM('sopstove_'//clsubb(jn)) 
     193                    CALL iom_put( cl1, z2d ) 
     194                END DO 
     195             ENDIF 
     196         ENDIF 
     197         IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 
     198         ! Calculate barotropic heat and salt transport here  
     199             sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 
     200             r1_sjk(:,1,1) = 0._wp 
     201             WHERE( sjk(:,1,1) /= 0._wp )   r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 
     202             
     203            vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 
     204            tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 
     205            tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 
     206            htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 
     207            str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 
     208            z2d(1,:) = htr_btr(:,1) * rc_pwatt        !  (conversion in PW) 
     209            DO ji = 2, jpi 
     210               z2d(ji,:) = z2d(1,:) 
     211            ENDDO 
     212            cl1 = 'sophtbtr' 
     213            CALL iom_put( TRIM(cl1), z2d ) 
     214            z2d(1,:) = str_btr(:,1) * rc_ggram        !  (conversion in Gg) 
     215            DO ji = 2, jpi 
     216              z2d(ji,:) = z2d(1,:) 
     217            ENDDO 
     218            cl1 = 'sopstbtr' 
     219            CALL iom_put( TRIM(cl1), z2d ) 
     220            IF( ln_subbas ) THEN 
     221                DO jn = 2, nptr 
     222                    sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 
     223                    r1_sjk(:,1,jn) = 0._wp 
     224                    WHERE( sjk(:,1,jn) /= 0._wp )   r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 
     225                    vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 
     226                    tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 
     227                    tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 
     228                    htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 
     229                    str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 
     230                    z2d(1,:) = htr_btr(:,jn) * rc_pwatt !  (conversion in PW) 
     231                    DO ji = 1, jpi 
     232                        z2d(ji,:) = z2d(1,:) 
     233                    ENDDO 
     234                    cl1 = TRIM('sophtbtr_'//clsubb(jn)) 
     235                    CALL iom_put( cl1, z2d ) 
     236                    z2d(1,:) = str_btr(:,jn) * rc_ggram        ! (conversion in Gg) 
     237                    DO ji = 1, jpi 
     238                        z2d(ji,:) = z2d(1,:) 
     239                    ENDDO 
     240                    cl1 = TRIM('sopstbtr_'//clsubb(jn)) 
     241                    CALL iom_put( cl1, z2d ) 
     242               ENDDO 
     243            ENDIF !ln_subbas 
     244         ENDIF !iom_use("sopstbtr....) 
    113245         ! 
    114246      ELSE 
     
    150282         !                                ! Advective and diffusive heat and salt transport 
    151283         IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN    
    152             z2d(1,:) = htr_adv(:) * rc_pwatt        !  (conversion in PW) 
     284            z2d(1,:) = htr_adv(:,1) * rc_pwatt        !  (conversion in PW) 
    153285            DO ji = 1, jpi 
    154286               z2d(ji,:) = z2d(1,:) 
     
    156288            cl1 = 'sophtadv'                  
    157289            CALL iom_put( TRIM(cl1), z2d ) 
    158             z2d(1,:) = str_adv(:) * rc_ggram        ! (conversion in Gg) 
     290            z2d(1,:) = str_adv(:,1) * rc_ggram        ! (conversion in Gg) 
    159291            DO ji = 1, jpi 
    160292               z2d(ji,:) = z2d(1,:) 
     
    162294            cl1 = 'sopstadv' 
    163295            CALL iom_put( TRIM(cl1), z2d ) 
     296            IF( ln_subbas ) THEN 
     297              DO jn=2,nptr 
     298               z2d(1,:) = htr_adv(:,jn) * rc_pwatt        !  (conversion in PW) 
     299               DO ji = 1, jpi 
     300                 z2d(ji,:) = z2d(1,:) 
     301               ENDDO 
     302               cl1 = TRIM('sophtadv_'//clsubb(jn))                  
     303               CALL iom_put( cl1, z2d ) 
     304               z2d(1,:) = str_adv(:,jn) * rc_ggram        ! (conversion in Gg) 
     305               DO ji = 1, jpi 
     306                  z2d(ji,:) = z2d(1,:) 
     307               ENDDO 
     308               cl1 = TRIM('sopstadv_'//clsubb(jn))                  
     309               CALL iom_put( cl1, z2d )               
     310              ENDDO 
     311            ENDIF 
    164312         ENDIF 
    165313         ! 
    166314         IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN    
    167             z2d(1,:) = htr_ldf(:) * rc_pwatt        !  (conversion in PW)  
     315            z2d(1,:) = htr_ldf(:,1) * rc_pwatt        !  (conversion in PW)  
    168316            DO ji = 1, jpi 
    169317               z2d(ji,:) = z2d(1,:) 
     
    171319            cl1 = 'sophtldf' 
    172320            CALL iom_put( TRIM(cl1), z2d ) 
    173             z2d(1,:) = str_ldf(:) * rc_ggram        !  (conversion in Gg) 
     321            z2d(1,:) = str_ldf(:,1) * rc_ggram        !  (conversion in Gg) 
    174322            DO ji = 1, jpi 
    175323               z2d(ji,:) = z2d(1,:) 
     
    177325            cl1 = 'sopstldf' 
    178326            CALL iom_put( TRIM(cl1), z2d ) 
    179          ENDIF 
     327            IF( ln_subbas ) THEN 
     328              DO jn=2,nptr 
     329               z2d(1,:) = htr_ldf(:,jn) * rc_pwatt        !  (conversion in PW) 
     330               DO ji = 1, jpi 
     331                 z2d(ji,:) = z2d(1,:) 
     332               ENDDO 
     333               cl1 = TRIM('sophtldf_'//clsubb(jn))                  
     334               CALL iom_put( cl1, z2d ) 
     335               z2d(1,:) = str_ldf(:,jn) * rc_ggram        ! (conversion in Gg) 
     336               DO ji = 1, jpi 
     337                  z2d(ji,:) = z2d(1,:) 
     338               ENDDO 
     339               cl1 = TRIM('sopstldf_'//clsubb(jn))                  
     340               CALL iom_put( cl1, z2d )               
     341              ENDDO 
     342            ENDIF 
     343         ENDIF 
     344 
     345         IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN    
     346            z2d(1,:) = htr_vt(:,1) * rc_pwatt        !  (conversion in PW)  
     347            DO ji = 1, jpi 
     348               z2d(ji,:) = z2d(1,:) 
     349            ENDDO 
     350            cl1 = 'sopht_vt' 
     351            CALL iom_put( TRIM(cl1), z2d ) 
     352            z2d(1,:) = str_vs(:,1) * rc_ggram        !  (conversion in Gg) 
     353            DO ji = 1, jpi 
     354               z2d(ji,:) = z2d(1,:) 
     355            ENDDO 
     356            cl1 = 'sopst_vs' 
     357            CALL iom_put( TRIM(cl1), z2d ) 
     358            IF( ln_subbas ) THEN 
     359              DO jn=2,nptr 
     360               z2d(1,:) = htr_vt(:,jn) * rc_pwatt        !  (conversion in PW) 
     361               DO ji = 1, jpi 
     362                 z2d(ji,:) = z2d(1,:) 
     363               ENDDO 
     364               cl1 = TRIM('sopht_vt_'//clsubb(jn))                  
     365               CALL iom_put( cl1, z2d ) 
     366               z2d(1,:) = str_vs(:,jn) * rc_ggram        ! (conversion in Gg) 
     367               DO ji = 1, jpi 
     368                  z2d(ji,:) = z2d(1,:) 
     369               ENDDO 
     370               cl1 = TRIM('sopst_vs_'//clsubb(jn))                  
     371               CALL iom_put( cl1, z2d )               
     372              ENDDO 
     373            ENDIF 
     374         ENDIF 
     375 
     376#ifdef key_diaeiv 
     377         IF(lk_traldf_eiv) THEN 
     378            IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
     379               z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
     380               DO ji = 1, jpi 
     381                  z2d(ji,:) = z2d(1,:) 
     382               ENDDO 
     383               cl1 = 'sophteiv' 
     384               CALL iom_put( TRIM(cl1), z2d ) 
     385               z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg) 
     386               DO ji = 1, jpi 
     387                  z2d(ji,:) = z2d(1,:) 
     388               ENDDO 
     389               cl1 = 'sopsteiv' 
     390               CALL iom_put( TRIM(cl1), z2d ) 
     391               IF( ln_subbas ) THEN 
     392                  DO jn=2,nptr 
     393                     z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW) 
     394                     DO ji = 1, jpi 
     395                        z2d(ji,:) = z2d(1,:) 
     396                     ENDDO 
     397                     cl1 = TRIM('sophteiv_'//clsubb(jn))                  
     398                     CALL iom_put( cl1, z2d ) 
     399                     z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg) 
     400                     DO ji = 1, jpi 
     401                        z2d(ji,:) = z2d(1,:) 
     402                     ENDDO 
     403                     cl1 = TRIM('sopsteiv_'//clsubb(jn))  
     404                     CALL iom_put( cl1, z2d )               
     405                  ENDDO 
     406               ENDIF 
     407            ENDIF 
     408         ENDIF 
     409#endif 
    180410         ! 
    181411      ENDIF 
     
    256486         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    257487         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    258          htr_adv(:) = 0._wp  ;  str_adv(:) =  0._wp   
    259          htr_ldf(:) = 0._wp  ;  str_ldf(:) =  0._wp  
     488         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
     489         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
     490         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     491         htr_vt(:,:) = 0._wp  ;   str_vs(:,:) =  0._wp 
     492         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
     493         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
    260494         ! 
    261495      ENDIF  
     
    263497   END SUBROUTINE dia_ptr_init 
    264498 
     499   SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva )  
     500      !!---------------------------------------------------------------------- 
     501      !!                    ***  ROUTINE dia_ptr_ohst_components  *** 
     502      !!---------------------------------------------------------------------- 
     503      !! Wrapper for heat and salt transport calculations to calculate them for each basin 
     504      !! Called from all advection and/or diffusion routines 
     505      !!---------------------------------------------------------------------- 
     506      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
     507      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
     508      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
     509      INTEGER                                        :: jn    ! 
     510 
     511      IF( cptr == 'adv' ) THEN 
     512         IF( ktra == jp_tem )  htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     513         IF( ktra == jp_sal )  str_adv(:,1) = ptr_sj( pva(:,:,:) ) 
     514      ENDIF 
     515      IF( cptr == 'ldf' ) THEN 
     516         IF( ktra == jp_tem )  htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     517         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
     518      ENDIF 
     519      IF( cptr == 'eiv' ) THEN 
     520         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     521         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     522      ENDIF 
     523      IF( cptr == 'vts' ) THEN 
     524         IF( ktra == jp_tem )  htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 
     525         IF( ktra == jp_sal )  str_vs(:,1) = ptr_sj( pva(:,:,:) ) 
     526      ENDIF 
     527      ! 
     528      IF( ln_subbas ) THEN 
     529         ! 
     530         IF( cptr == 'adv' ) THEN 
     531             IF( ktra == jp_tem ) THEN  
     532                DO jn = 2, nptr 
     533                   htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     534                END DO 
     535             ENDIF 
     536             IF( ktra == jp_sal ) THEN  
     537                DO jn = 2, nptr 
     538                   str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     539                END DO 
     540             ENDIF 
     541         ENDIF 
     542         IF( cptr == 'ldf' ) THEN 
     543             IF( ktra == jp_tem ) THEN  
     544                DO jn = 2, nptr 
     545                    htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     546                 END DO 
     547             ENDIF 
     548             IF( ktra == jp_sal ) THEN  
     549                DO jn = 2, nptr 
     550                   str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     551                END DO 
     552             ENDIF 
     553         ENDIF 
     554         IF( cptr == 'eiv' ) THEN 
     555             IF( ktra == jp_tem ) THEN  
     556                DO jn = 2, nptr 
     557                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     558                 END DO 
     559             ENDIF 
     560             IF( ktra == jp_sal ) THEN  
     561                DO jn = 2, nptr 
     562                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     563                END DO 
     564             ENDIF 
     565         ENDIF 
     566         IF( cptr == 'vts' ) THEN 
     567             IF( ktra == jp_tem ) THEN  
     568                DO jn = 2, nptr 
     569                    htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     570                 END DO 
     571             ENDIF 
     572             IF( ktra == jp_sal ) THEN  
     573                DO jn = 2, nptr 
     574                   str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     575                END DO 
     576             ENDIF 
     577         ENDIF 
     578         ! 
     579      ENDIF 
     580   END SUBROUTINE dia_ptr_ohst_components 
     581 
    265582 
    266583   FUNCTION dia_ptr_alloc() 
     
    273590      ierr(:) = 0 
    274591      ! 
    275       ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    276          &      htr_adv(jpj) , str_adv(jpj) ,   & 
    277          &      htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1)  ) 
     592      ALLOCATE( btmsk(jpi,jpj,nptr) ,              & 
     593         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
     594         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
     595         &      htr_vt(jpj,nptr)  , str_vs(jpj,nptr)  ,   & 
     596         &      htr_ove(jpj,nptr) , str_ove(jpj,nptr) ,   & 
     597         &      htr_btr(jpj,nptr) , str_btr(jpj,nptr) ,   & 
     598         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  ) 
    278599         ! 
    279600      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 
     
    402723#endif 
    403724      !!-------------------------------------------------------------------- 
    404       ! 
     725     ! 
    405726      p_fval => p_fval2d 
    406727 
     
    434755#endif 
    435756      ! 
     757 
    436758   END FUNCTION ptr_sjk 
    437759 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7256 r7806  
    156156      IF( iom_use("e3tdef") )   & 
    157157         CALL iom_put( "e3tdef"  , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 
     158      CALL iom_put("tpt_dep", fsdept_n(:,:,:) ) 
     159 
    158160 
    159161 
     
    318320      CALL iom_put( "hdiv", hdivn )                  ! Horizontal divergence 
    319321      ! 
    320       IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
     322      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    321323         z3d(:,:,jpk) = 0.e0 
     324         z2d(:,:) = 0.e0 
    322325         DO jk = 1, jpkm1 
    323326            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     327            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    324328         END DO 
    325329         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     330         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    326331      ENDIF 
    327332       
     
    386391         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    387392      ENDIF 
     393 
     394      ! Vertical integral of temperature 
     395      IF( iom_use("tosmint") ) THEN 
     396         z2d(:,:)=0._wp 
     397         DO jk = 1, jpkm1 
     398            DO jj = 2, jpjm1 
     399               DO ji = fs_2, fs_jpim1   ! vector opt. 
     400                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) *  tsn(ji,jj,jk,jp_tem) 
     401               END DO 
     402            END DO 
     403         END DO 
     404         CALL lbc_lnk( z2d, 'T', -1. ) 
     405         CALL iom_put( "tosmint", z2d )  
     406      ENDIF 
     407 
     408      ! Vertical integral of salinity 
     409      IF( iom_use("somint") ) THEN 
     410         z2d(:,:)=0._wp 
     411         DO jk = 1, jpkm1 
     412            DO jj = 2, jpjm1 
     413               DO ji = fs_2, fs_jpim1   ! vector opt. 
     414                  z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 
     415               END DO 
     416            END DO 
     417         END DO 
     418         CALL lbc_lnk( z2d, 'T', -1. ) 
     419         CALL iom_put( "somint", z2d )  
     420      ENDIF 
     421 
     422      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2) 
    388423      ! 
    389424      CALL wrk_dealloc( jpi , jpj      , z2d ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7217 r7806  
    2323   USE dom_oce         ! domain: ocean 
    2424   USE sbc_oce         ! surface boundary condition: ocean 
     25   USE trc_oce         ! shared ocean-passive tracers variables 
    2526   USE phycst          ! physical constants 
    2627   USE closea          ! closed seas 
     
    9798      END DO 
    9899      ! 
    99       IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh 
    100       ! 
    101       IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
    102       ! 
    103       ! 
    104       hu(:,:) = 0._wp                          ! Ocean depth at U-points 
    105       hv(:,:) = 0._wp                          ! Ocean depth at V-points 
    106       ht(:,:) = 0._wp                          ! Ocean depth at T-points 
    107       DO jk = 1, jpkm1 
    108          hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
    109          hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
    110          ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    111       END DO 
    112       !                                        ! Inverse of the local depth 
    113       hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    114       hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     100      IF( lk_c1d )           CALL cor_c1d      ! 1D configuration: Coriolis set at T-point 
     101      ! 
     102      IF( .NOT.lk_offline ) THEN 
     103        ! 
     104        IF( lk_vvl )         CALL dom_vvl_init ! Vertical variable mesh 
     105        ! 
     106        hu(:,:) = 0._wp                          ! Ocean depth at U-points 
     107        hv(:,:) = 0._wp                          ! Ocean depth at V-points 
     108        ht(:,:) = 0._wp                          ! Ocean depth at T-points 
     109        DO jk = 1, jpkm1 
     110           hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
     111           hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     112           ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     113        END DO 
     114        !                                        ! Inverse of the local depth 
     115        hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
     116        hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
     117        ! 
     118      ENDIF 
    115119 
    116120                             CALL dom_stp      ! time step 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r7256 r7806  
    395395      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry' 
    396396      IF(lwp) WRITE(numout,*) '    ~~~~~~~' 
     397      ! 
     398      ! (ISF) initialisation ice shelf draft and top level 
     399      risfdep(:,:)=0._wp 
     400      misfdep(:,:)=1 
    397401      !                                               ! ================== !  
    398402      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  ! 
     
    484488            END DO 
    485489         END DO 
    486          risfdep(:,:)=0.e0 
    487          misfdep(:,:)=1 
    488490         ! 
    489491         DEALLOCATE( idta, zdta ) 
     
    535537            CALL iom_close( inum ) 
    536538            !                                                 
    537             risfdep(:,:)=0._wp          
    538             misfdep(:,:)=1              
    539539            IF ( ln_isfcav ) THEN 
    540540               CALL iom_open ( 'isf_draft_meter.nc', inum )  
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5602 r7806  
    6565#if defined key_lim3 || defined key_cice 
    6666   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    67    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    68    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    69    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     67   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     68   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K] 
    7069   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7170   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
     
    8382   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
    8483   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     84#endif 
     85#if defined key_cice 
     86   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K], now namelist parameter for LIM3 
    8587#endif 
    8688#if defined key_lim3 
     
    177179      IF(lwp) THEN 
    178180         WRITE(numout,*) 
     181#if defined key_cice 
    179182         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    180          WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
     183#endif 
     184         WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    181185         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    182186         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4990 r7806  
    166166            ! 
    167167         ENDIF 
     168        IF( l_trddyn )   THEN                      ! Put here so code doesn't crash when doing KE trend but needs to be done properly 
     169            CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 
     170         ENDIF 
    168171         ! 
    169172      ELSE                       ! fixed volume  (add the surface pressure gradient + unweighted time stepping) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5602 r7806  
    601601            DO jk = 1, jpk 
    602602               DO jj = 1, jpjm1 
    603                   DO ji = 1, jpim1 
     603                  DO ji = 1, fs_jpim1 
    604604                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    605605                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    606                      IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = 4.0_wp / ze3 
     606                     IF   ( ze3 /= 0._wp ) THEN ;   ze3f(ji,jj,jk) = 4.0_wp / ze3 
     607                     ELSE                       ;   ze3f(ji,jj,jk) = 0.0_wp 
     608                     ENDIF 
    607609                  END DO 
    608610               END DO 
     
    611613            DO jk = 1, jpk 
    612614               DO jj = 1, jpjm1 
    613                   DO ji = 1, jpim1 
     615                  DO ji = 1, fs_jpim1 
    614616                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    615617                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    616618                     zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    617619                        &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
    618                      IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3 
     620                     IF   ( ze3 /= 0._wp ) THEN ;   ze3f(ji,jj,jk) = zmsk / ze3 
     621                     ELSE                       ;   ze3f(ji,jj,jk) = 0.0_wp 
     622                     ENDIF 
    619623                  END DO 
    620624               END DO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r7398 r7806  
    235235      ! automatic definitions of some of the xml attributs 
    236236      CALL set_xmlatt 
     237 
     238      CALL set_1point 
    237239 
    238240      ! end file definition 
     
    15861588      zz=REAL(narea,wp) 
    15871589      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1588        
     1590 
    15891591   END SUBROUTINE set_scalar 
     1592 
     1593   SUBROUTINE set_1point 
     1594      !!---------------------------------------------------------------------- 
     1595      !!                     ***  ROUTINE set_1point  *** 
     1596      !! 
     1597      !! ** Purpose :   define zoom grid for scalar fields 
     1598      !! 
     1599      !!---------------------------------------------------------------------- 
     1600      REAL(wp), DIMENSION(1)   ::   zz = 1. 
     1601      INTEGER  :: ix, iy 
     1602      !!---------------------------------------------------------------------- 
     1603      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  Nearest point to north pole should be ocean 
     1604      CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 
     1605 
     1606   END SUBROUTINE set_1point 
    15901607 
    15911608 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r5601 r7806  
    804804            ELSE 
    805805               startloop = 3 
    806                pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     806               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    807807            ENDIF 
    808808            DO ji = startloop, nlci 
     
    816816            ELSE 
    817817               startloop = 3 
    818                pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
     818               pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    819819            ENDIF 
    820820            DO ji = startloop, nlci 
     
    910910               DO ji = startloop , endloop 
    911911                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    912                   pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
     912                  pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    913913               END DO 
    914914 
     
    926926               DO ji = startloop , endloop 
    927927                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    928                   pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
     928                  pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 
    929929               END DO 
    930930 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7256 r7806  
    40264026      INTEGER          , INTENT(inout) ::   kios      ! IO status after reading the namelist 
    40274027      CHARACTER(len=*) , INTENT(in   ) ::   cdnam     ! group name of namelist for which error occurs 
    4028       CHARACTER(len=4)                 ::   clios     ! string to convert iostat in character for print 
     4028      CHARACTER(len=5)                 ::   clios     ! string to convert iostat in character for print 
    40294029      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print 
    40304030      !!---------------------------------------------------------------------- 
     
    40324032      !  
    40334033      ! ---------------- 
    4034       WRITE (clios, '(I4.0)') kios 
     4034      WRITE (clios, '(I5.0)') kios 
    40354035      IF( kios < 0 ) THEN          
    40364036         CALL ctl_warn( 'W A R N I N G:  end of record or file while reading namelist ' & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r7256 r7806  
    3939   !                             !!* namelist namsbc_alb 
    4040   INTEGER  ::   nn_ice_alb 
    41    REAL(wp) ::   rn_albice 
     41   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 
    4242 
    4343   !!---------------------------------------------------------------------- 
     
    101101      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    102102 
     103      ralb_sf = rn_alb_sdry ! dry snow 
     104      ralb_sm = rn_alb_smlt ! melting snow 
     105      ralb_if = rn_alb_idry ! bare frozen ice 
     106      ralb_im = rn_alb_imlt ! bare puddled ice  
    103107       
    104108      SELECT CASE ( nn_ice_alb ) 
     
    109113      CASE( 0 ) 
    110114        
    111          ralb_sf = 0.80       ! dry snow 
    112          ralb_sm = 0.65       ! melting snow 
    113          ralb_if = 0.72       ! bare frozen ice 
    114          ralb_im = rn_albice  ! bare puddled ice  
    115           
     115         !ralb_sf = 0.80       ! dry snow 
     116         !ralb_sm = 0.65       ! melting snow 
     117         !ralb_if = 0.72       ! bare frozen ice 
     118         !ralb_im = ...        ! bare puddled ice  
     119 
    116120         !  Computation of ice albedo (free of snow) 
    117121         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
     
    163167      CASE( 1 )  
    164168 
    165          ralb_im = rn_albice  ! bare puddled ice 
     169!        ralb_im = ...        ! bare puddled ice 
    166170! compilation of values from literature 
    167          ralb_sf = 0.85      ! dry snow 
    168          ralb_sm = 0.75      ! melting snow 
    169          ralb_if = 0.60      ! bare frozen ice 
     171!        ralb_sf = 0.85      ! dry snow 
     172!        ralb_sm = 0.75      ! melting snow 
     173!        ralb_if = 0.60      ! bare frozen ice 
    170174! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 
    171175!         ralb_sf = 0.85       ! dry snow 
     
    248252      !!---------------------------------------------------------------------- 
    249253      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    250       NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
     254      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt 
    251255      !!---------------------------------------------------------------------- 
    252256      ! 
     
    268272         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
    269273         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb 
    270          WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice 
     274         WRITE(numout,*) '      albedo of dry snow                                  rn_alb_sdry = ', rn_alb_sdry 
     275         WRITE(numout,*) '      albedo of melting snow                              rn_alb_smlt = ', rn_alb_smlt 
     276         WRITE(numout,*) '      albedo of dry ice                                   rn_alb_idry = ', rn_alb_idry 
     277         WRITE(numout,*) '      albedo of bare puddled ice                          rn_alb_imlt = ', rn_alb_imlt 
    271278      ENDIF 
    272279      ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5602 r7806  
    113113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]   
    114114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]   
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]   
    115116   !! 
    116117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
     
    164165         ! 
    165166      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    166          &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     167         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,     & 
     168         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) ) 
    167169         ! 
    168170      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7256 r7806  
    4343   USE eosbn2 
    4444   USE sbcrnf   , ONLY : l_rnfcpl 
     45   USE sbcisf   , ONLY : l_isfcpl 
    4546#if defined key_cpl_carbon_cycle 
    4647   USE p4zflx, ONLY : oce_co2 
     
    105106   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106107   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108   INTEGER, PARAMETER ::   jpr_isf    = 43 
     109   INTEGER, PARAMETER ::   jpr_icb    = 44 
     110   INTEGER, PARAMETER ::   jprcv      = 44            ! total number of fields received 
    108111 
    109112   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
     
    149152   ! Received from the atmosphere                     ! 
    150153   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    151    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     154   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_icb, sn_rcv_isf                                
    152155   ! Other namelist parameters                        ! 
    153156   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     
    219222         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
    220223         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
    221          &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
     224         &                  sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf, nn_cplmodel  , ln_usecplmask 
    222225      !!--------------------------------------------------------------------- 
    223226      ! 
     
    258261         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    259262         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     263         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')' 
     264         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
    260265         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    261266         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     
    397402      END SELECT 
    398403 
    399       !                                                      ! ------------------------- ! 
    400       !                                                      !     Runoffs & Calving     !    
    401       !                                                      ! ------------------------- ! 
     404 
     405      !                                                      ! ---------------------------------------------------- ! 
     406      !                                                      !     Runoffs, Calving, Iceberg, Iceshelf cavities     !    
     407      !                                                      ! ---------------------------------------------------- ! 
    402408      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    403409      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
     
    409415      ENDIF 
    410416      ! 
    411       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     417      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     418      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
     419      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     420 
     421      IF( srcv(jpr_isf)%laction .AND. nn_isf > 0 ) THEN 
     422         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf 
     423         IF(lwp) WRITE(numout,*) 
     424         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis ' 
     425      ENDIF 
    412426 
    413427      !                                                      ! ------------------------- ! 
     
    10711085         ENDIF 
    10721086         ! 
     1087         !    
    10731088         !                                                        ! runoffs and calving (added in emp) 
    1074          IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1089         IF( srcv(jpr_rnf)%laction )     rnf(:,:)  = frcv(jpr_rnf)%z3(:,:,1) 
    10751090         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1091 
     1092         IF( srcv(jpr_icb)%laction )  THEN  
     1093             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1094             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs 
     1095         ENDIF 
     1096         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
    10761097          
    10771098         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
     
    10911112            ENDIF 
    10921113         ENDIF 
     1114         ! 
     1115         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1116         ! 
    10931117         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
    10941118         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
     
    13871411      ! 
    13881412      INTEGER ::   jl         ! dummy loop index 
    1389       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk, zsnw 
     1413      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw 
    13901414      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 
    13911415      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     
    13951419      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    13961420      ! 
    1397       CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1421      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
    13981422      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    13991423      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
     
    14181442         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    14191443         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 
    1420                CALL iom_put( 'rain'         ,   frcv(jpr_rain)%z3(:,:,1)                                                         )  ! liquid precipitation  
     1444         IF( iom_use('precip') )          & 
     1445            &  CALL iom_put( 'precip'       ,   frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1)                              )  ! total  precipitation 
     1446         IF( iom_use('rain') )            & 
     1447            &  CALL iom_put( 'rain'         ,   frcv(jpr_rain)%z3(:,:,1)                                                         )  ! liquid precipitation  
     1448         IF( iom_use('rain_ao_cea') )   & 
     1449            &  CALL iom_put( 'rain_ao_cea'  , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1)      )   ! liquid precipitation  
    14211450         IF( iom_use('hflx_rain_cea') )   & 
    1422             &  CALL iom_put( 'hflx_rain_cea',   frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:)                                            )  ! heat flux from liq. precip.  
     1451            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1))   ! heat flux from liq. precip.  
     1452         IF( iom_use('hflx_prec_cea') )   & 
     1453            CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) )   ! heat content flux from all precip  (cell avg) 
     1454         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
     1455            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    14231456         IF( iom_use('evap_ao_cea'  ) )   & 
    1424             &  CALL iom_put( 'evap_ao_cea'  ,   frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)                )  ! ice-free oce evap (cell average) 
     1457            CALL iom_put( 'evap_ao_cea'  , ztmp * tmask(:,:,1)                  )   ! ice-free oce evap (cell average) 
    14251458         IF( iom_use('hflx_evap_cea') )   & 
    1426             &  CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) )  ! heat flux from from evap (cell average) 
    1427       CASE( 'oce and ice' )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
     1459            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) )   ! heat flux from from evap (cell average) 
     1460      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    14281461         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    14291462         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 
     
    14581491         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    14591492      ENDIF 
     1493 
     1494      IF( srcv(jpr_icb)%laction )  THEN  
     1495         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1496         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1497         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1498      ENDIF 
     1499      IF( srcv(jpr_isf)%laction )  THEN 
     1500        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1501        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1502      ENDIF 
     1503 
    14601504 
    14611505      IF( ln_mixcpl ) THEN 
     
    14881532      ! runoffs and calving (put in emp_tot) 
    14891533      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1534      IF( iom_use('hflx_rnf_cea') )   & 
     1535         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
    14901536      IF( srcv(jpr_cal)%laction ) THEN  
    14911537         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    14921538         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    14931539      ENDIF 
     1540 
     1541 
     1542      IF( srcv(jpr_icb)%laction )  THEN  
     1543         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1544         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1545         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1546      ENDIF 
     1547      IF( srcv(jpr_isf)%laction )  THEN 
     1548        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1549        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1550      ENDIF 
     1551 
    14941552 
    14951553      IF( ln_mixcpl ) THEN 
     
    15601618      ENDIF 
    15611619 
     1620!!chris      
     1621!!    The heat content associated to the ice shelf in removed in the routine sbcisf.F90 
     1622      ! 
     1623      IF( srcv(jpr_icb)%laction )  zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1624      ! 
     1625!!      ! 
     1626 
    15621627#if defined key_lim3       
    15631628      ! --- non solar flux over ocean --- ! 
     
    15661631      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
    15671632 
     1633      ! Heat content per unit mass of snow (J/kg) 
     1634      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = cpic * SUM( (tn_ice -rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1635      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:) 
     1636      ENDWHERE 
     1637      ! Heat content per unit mass of rain (J/kg) 
     1638      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) -rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )  
     1639 
    15681640      ! --- heat flux associated with emp (W/m2) --- ! 
    15691641      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn(:,:)   &       ! evap 
    1570          &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &       ! liquid precip 
    1571          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus )  ! solid precip over ocean + snow melting 
     1642         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &       ! liquid precip 
     1643         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw(:,:) - lfus )  ! solid precip over ocean + snow melting 
    15721644!      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
    15731645!         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
    1574       zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 
     1646      zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptsnw(:,:) - lfus ) ! solid precip over ice (only) 
    15751647                                                                                                       ! qevap_ice=0 since we consider Tice=0degC 
    15761648       
    15771649      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    1578       zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1650      zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus ) 
     1651      !zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1652       
    15791653 
    15801654      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
     
    17371811      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    17381812 
    1739       CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1813      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
    17401814      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    17411815      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r7256 r7806  
    650650CONTAINS 
    651651   SUBROUTINE sbc_ice_lim ( kt, kblk )     ! Dummy routine 
     652      INTEGER, INTENT(in) ::   kt, kblk 
    652653      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 
    653654   END SUBROUTINE sbc_ice_lim 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r7256 r7806  
    3232   PRIVATE 
    3333 
    34    PUBLIC   sbc_isf, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur 
     34   PUBLIC   sbc_isf, sbc_isf_init, sbc_isf_div, sbc_isf_alloc  ! routine called in sbcmod and divcur 
    3535 
    3636   ! public in order to be able to output then  
     
    5454   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 
    5555   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
     56 
     57   LOGICAL, PUBLIC ::   l_isfcpl = .false.       ! isf recieved from oasis 
    5658 
    5759 
     
    8183  
    8284  SUBROUTINE sbc_isf(kt) 
     85 
    8386    INTEGER, INTENT(in)          ::   kt         ! ocean time step 
     87    INTEGER                      ::   ji, jj, jk 
     88    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer 
     89    REAL(wp)                     ::   zhk 
     90    REAL(wp)                     ::   zt_frz, zpress 
     91    REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 
     92    REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d 
     93    REAL(wp)                            :: zhisf 
     94 
     95 
     96      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
     97 
     98         ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 
     99         DO jj = 1,jpj 
     100            DO ji = 1,jpi 
     101               ikt = misfkt(ji,jj) 
     102               ikb = misfkt(ji,jj) 
     103               ! thickness of boundary layer at least the top level thickness 
     104               rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt)) 
     105 
     106               ! determine the deepest level influenced by the boundary layer 
     107               DO jk = ikt, mbkt(ji,jj) 
     108                  IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     109               END DO 
     110               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
     111               misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
     112               r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
     113 
     114               zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
     115               ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
     116            END DO 
     117         END DO 
     118 
     119         ! compute salf and heat flux 
     120         IF (nn_isf == 1) THEN 
     121            ! realistic ice shelf formulation 
     122            ! compute T/S/U/V for the top boundary layer 
     123            CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T') 
     124            CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T') 
     125            CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U') 
     126            CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V') 
     127            ! iom print 
     128            CALL iom_put('ttbl',ttbl(:,:)) 
     129            CALL iom_put('stbl',stbl(:,:)) 
     130            CALL iom_put('utbl',utbl(:,:)) 
     131            CALL iom_put('vtbl',vtbl(:,:)) 
     132            ! compute fwf and heat flux 
     133            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt) 
     134            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * lfusisf              ! heat        flux 
     135            ENDIF 
     136 
     137         ELSE IF (nn_isf == 2) THEN 
     138            ! Beckmann and Goosse parametrisation  
     139            stbl(:,:)   = soce 
     140            CALL sbc_isf_bg03(kt) 
     141 
     142         ELSE IF (nn_isf == 3) THEN 
     143            ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
     144            IF( .NOT.l_isfcpl ) THEN 
     145               CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
     146               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
     147            ENDIF 
     148            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
     149            stbl(:,:)   = soce 
     150 
     151         ELSE IF (nn_isf == 4) THEN 
     152            ! specified fwf and heat flux forcing beneath the ice shelf 
     153            IF( .NOT.l_isfcpl ) THEN 
     154               CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
     155               !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
     156               fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
     157            ENDIF 
     158            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
     159            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
     160            stbl(:,:)   = soce 
     161 
     162         END IF 
     163         ! compute tsc due to isf 
     164         ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 
     165!         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
     166         zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
     167         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 
     168          
     169         ! salt effect already take into account in vertical advection 
     170         risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 
     171 
     172         ! output 
     173         IF( iom_use('qlatisf' ) )   CALL iom_put('qlatisf', qisf) 
     174         IF( iom_use('fwfisf'  ) )   CALL iom_put('fwfisf' , fwfisf * stbl(:,:) / soce ) 
     175 
     176         ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 
     177         fwfisf(:,:) = rdivisf * fwfisf(:,:)          
     178  
     179         ! lbclnk 
     180         CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) 
     181         CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.) 
     182         CALL lbc_lnk(fwfisf(:,:)   ,'T',1.) 
     183         CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
     184 
     185         ! Diagnostics 
     186         IF( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 
     187            ! 
     188            CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     189            CALL wrk_alloc( jpi,jpj,     zqhcisf2d                        ) 
     190            ! 
     191            zfwfisf3d(:,:,:) = 0.0_wp                         ! 3d ice shelf melting (kg/m2/s) 
     192            zqhcisf3d(:,:,:) = 0.0_wp                         ! 3d heat content flux (W/m2) 
     193            zqlatisf3d(:,:,:)= 0.0_wp                         ! 3d ice shelf melting latent heat flux (W/m2) 
     194            zqhcisf2d(:,:)   = fwfisf(:,:) * zt_frz * rcp     ! 2d heat content flux (W/m2) 
     195            ! 
     196            DO jj = 1,jpj 
     197               DO ji = 1,jpi 
     198                  ikt = misfkt(ji,jj) 
     199                  ikb = misfkb(ji,jj) 
     200                  DO jk = ikt, ikb - 1 
     201                     zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     202                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf(ji,jj)    * zhisf 
     203                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf 
     204                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf(ji,jj)      * zhisf 
     205                  END DO 
     206                  jk = ikb 
     207                  zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     208                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * zhisf * ralpha(ji,jj)  
     209                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf * ralpha(ji,jj) 
     210                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * zhisf * ralpha(ji,jj) 
     211               END DO 
     212            END DO 
     213            ! 
     214            CALL iom_put( 'fwfisf3d' , zfwfisf3d (:,:,:) ) 
     215            CALL iom_put( 'qlatisf3d', zqlatisf3d(:,:,:) ) 
     216            CALL iom_put( 'qhcisf3d' , zqhcisf3d (:,:,:) ) 
     217            CALL iom_put( 'qhcisf'   , zqhcisf2d (:,:  ) ) 
     218            ! 
     219            CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
     220            CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        ) 
     221            ! 
     222         END IF 
     223         !  
     224      END IF 
     225      ! 
     226      ! 
     227      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
     228         IF( ln_rstart .AND.    &                     ! Restart: read in restart file 
     229              & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 
     230            IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
     231            CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) ) ! before salt content isf_tsc trend 
     232            CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend 
     233            CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend 
     234         ELSE 
     235            fwfisf_b(:,:)    = fwfisf(:,:) 
     236            risf_tsc_b(:,:,:)= risf_tsc(:,:,:) 
     237         END IF 
     238      ENDIF 
     239      ! 
     240      IF( lrst_oce ) THEN 
     241         IF(lwp) WRITE(numout,*) 
     242         IF(lwp) WRITE(numout,*) 'sbc : isf surface tracer content forcing fields written in ocean restart file ',   & 
     243            &                    'at it= ', kt,' date= ', ndastp 
     244         IF(lwp) WRITE(numout,*) '~~~~' 
     245         CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 
     246         CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 
     247         CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 
     248      ENDIF 
     249       ! 
     250  END SUBROUTINE sbc_isf 
     251 
     252  SUBROUTINE sbc_isf_init 
     253 
    84254    INTEGER                      ::   ji, jj, jk, ijkmin, inum, ierror 
    85255    INTEGER                      ::   ikt, ikb   ! top and bottom level of the isf boundary layer 
    86     REAL(wp)                     ::   rmin 
    87256    REAL(wp)                     ::   zhk 
    88     REAL(wp)                     ::   zt_frz, zpress 
    89257    CHARACTER(len=256)           ::   cfisf , cvarzisf, cvarhisf   ! name for isf file 
    90258    CHARACTER(LEN=256)           :: cnameis                     ! name of iceshelf file 
    91259    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale 
    92260    INTEGER           ::   ios           ! Local integer output status for namelist read 
     261 
    93262      ! 
    94263      !!--------------------------------------------------------------------- 
     
    97266      ! 
    98267      ! 
    99       !                                         ! ====================== ! 
    100       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    101          !                                      ! ====================== ! 
    102268         REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    103269         READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901) 
     
    139305            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv 
    140306         ELSE IF ((nn_isf == 3) .OR. (nn_isf == 2)) THEN 
    141             ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
    142             ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
    143             CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     307            IF( .NOT.l_isfcpl ) THEN 
     308               ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
     309               ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
     310               CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     311             ENDIF 
    144312 
    145313            !: read effective lenght (BG03) 
     
    182350             
    183351            ! load variable used in fldread (use for temporal interpolation of isf fwf forcing) 
    184             ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
    185             ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
    186             ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
    187             CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
    188             !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     352            IF( .NOT.l_isfcpl ) THEN 
     353               ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
     354               ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
     355               ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
     356               CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     357               !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     358            ENDIF 
    189359         END IF 
    190           
    191360         ! save initial top boundary layer thickness          
    192361         rhisf_tbl_0(:,:) = rhisf_tbl(:,:) 
    193  
    194       END IF 
    195  
    196       !                                            ! ---------------------------------------- ! 
    197       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    198          !                                         ! ---------------------------------------- ! 
    199          fwfisf_b  (:,:  ) = fwfisf  (:,:  )               ! Swap the ocean forcing fields except at nit000 
    200          risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               ! where before fields are set at the end of the routine 
    201          ! 
    202       ENDIF 
    203  
    204       IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 
    205  
    206          ! compute bottom level of isf tbl and thickness of tbl below the ice shelf 
    207          DO jj = 1,jpj 
    208             DO ji = 1,jpi 
    209                ikt = misfkt(ji,jj) 
    210                ikb = misfkt(ji,jj) 
    211                ! thickness of boundary layer at least the top level thickness 
    212                rhisf_tbl(ji,jj) = MAX(rhisf_tbl_0(ji,jj), fse3t_n(ji,jj,ikt)) 
    213  
    214                ! determine the deepest level influenced by the boundary layer 
    215                DO jk = ikt, mbkt(ji,jj) 
    216                   IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    217                END DO 
    218                rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    219                misfkb(ji,jj) = ikb                                                  ! last wet level of the tbl 
    220                r1_hisf_tbl(ji,jj) = 1._wp / rhisf_tbl(ji,jj) 
    221  
    222                zhk           = SUM( fse3t(ji, jj, ikt:ikb - 1)) * r1_hisf_tbl(ji,jj)  ! proportion of tbl cover by cell from ikt to ikb - 1 
    223                ralpha(ji,jj) = rhisf_tbl(ji,jj) * (1._wp - zhk ) / fse3t(ji,jj,ikb)  ! proportion of bottom cell influenced by boundary layer 
    224             END DO 
    225          END DO 
    226  
    227          ! compute salf and heat flux 
    228          IF (nn_isf == 1) THEN 
    229             ! realistic ice shelf formulation 
    230             ! compute T/S/U/V for the top boundary layer 
    231             CALL sbc_isf_tbl(tsn(:,:,:,jp_tem),ttbl(:,:),'T') 
    232             CALL sbc_isf_tbl(tsn(:,:,:,jp_sal),stbl(:,:),'T') 
    233             CALL sbc_isf_tbl(un(:,:,:),utbl(:,:),'U') 
    234             CALL sbc_isf_tbl(vn(:,:,:),vtbl(:,:),'V') 
    235             ! iom print 
    236             CALL iom_put('ttbl',ttbl(:,:)) 
    237             CALL iom_put('stbl',stbl(:,:)) 
    238             CALL iom_put('utbl',utbl(:,:)) 
    239             CALL iom_put('vtbl',vtbl(:,:)) 
    240             ! compute fwf and heat flux 
    241             CALL sbc_isf_cav (kt) 
    242  
    243          ELSE IF (nn_isf == 2) THEN 
    244             ! Beckmann and Goosse parametrisation  
    245             stbl(:,:)   = soce 
    246             CALL sbc_isf_bg03(kt) 
    247  
    248          ELSE IF (nn_isf == 3) THEN 
    249             ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
    250             CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
    251             fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
    252             qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    253             stbl(:,:)   = soce 
    254  
    255          ELSE IF (nn_isf == 4) THEN 
    256             ! specified fwf and heat flux forcing beneath the ice shelf 
    257             CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
    258             !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
    259             fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
    260             qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    261             !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
    262             stbl(:,:)   = soce 
    263  
    264          END IF 
    265          ! compute tsc due to isf 
    266          ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 
    267 !         zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 
    268          zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 
    269          risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 
    270           
    271          ! salt effect already take into account in vertical advection 
    272          risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 
    273  
    274          ! output 
    275          IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf) 
    276          IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 
    277  
    278          ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 
    279          fwfisf(:,:) = rdivisf * fwfisf(:,:)          
    280   
    281          ! lbclnk 
    282          CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) 
    283          CALL lbc_lnk(risf_tsc(:,:,jp_sal),'T',1.) 
    284          CALL lbc_lnk(fwfisf(:,:)   ,'T',1.) 
    285          CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
    286  
    287          IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    288             IF( ln_rstart .AND.    &                     ! Restart: read in restart file 
    289                  & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 
    290                IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    291                CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) )   ! before salt content isf_tsc trend 
    292                CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend 
    293                CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend 
    294             ELSE 
    295                fwfisf_b(:,:)    = fwfisf(:,:) 
    296                risf_tsc_b(:,:,:)= risf_tsc(:,:,:) 
    297             END IF 
    298          ENDIF 
    299362         !  
    300       END IF 
    301    
    302   END SUBROUTINE sbc_isf 
     363   END SUBROUTINE sbc_isf_init 
     364       
     365 
    303366 
    304367  INTEGER FUNCTION sbc_isf_alloc() 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7256 r7806  
    300300      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
    301301      ! 
     302      IF( nn_isf   /= 0    )   CALL sbc_isf_init               ! Compute iceshelves 
     303 
    302304                               CALL sbc_rnf_init               ! Runof initialisation 
    303305      ! 
     
    343345            rnf_b    (:,:  ) = rnf    (:,:  ) 
    344346            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     347         ENDIF 
     348         IF( nn_isf /= 0  )  THEN 
     349            fwfisf_b  (:,:  ) = fwfisf  (:,:  )                
     350            risf_tsc_b(:,:,:) = risf_tsc(:,:,:)               
    345351         ENDIF 
    346352      ENDIF 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5602 r7806  
    2626   USE cla             ! cross land advection      (cla_traadv     routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   USE trd_oce         ! trends: ocean variables 
     29   USE trdtra          ! trends manager: tracers  
    2830   ! 
    2931   USE in_out_manager  ! I/O manager 
     
    7981      INTEGER ::   jk   ! dummy loop index 
    8082      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    8184      !!---------------------------------------------------------------------- 
    8285      ! 
     
    120123      IF( ln_diaptr )   CALL dia_ptr( zvn )                                     ! diagnose the effective MSF  
    121124      ! 
    122     
     125      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     126         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     127         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     128         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     129      ENDIF 
     130      ! 
    123131      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    124132      CASE ( 1 )   ;    CALL tra_adv_cen2   ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     
    151159      END SELECT 
    152160      ! 
     161      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     162         DO jk = 1, jpkm1 
     163            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     164            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     165         END DO 
     166         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
     167         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
     168         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     169      ENDIF 
    153170      !                                              ! print mean trends (used for debugging) 
    154171      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r7256 r7806  
    279279         END IF 
    280280         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    281          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    282            IF( jn == jp_tem )   htr_adv(:) = ptr_sj( zwy(:,:,:) ) 
    283            IF( jn == jp_sal )   str_adv(:) = ptr_sj( zwy(:,:,:) ) 
    284          ENDIF 
     281         IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 
    285282         ! 
    286283      END DO 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r7256 r7806  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE diaptr         ! Heat/Salt transport diagnostics 
     31   USE trddyn 
     32   USE trd_oce 
    3033 
    3134   IMPLICIT NONE 
     
    7881# endif   
    7982      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 
    8084      !!---------------------------------------------------------------------- 
    8185      ! 
     
    8488# if defined key_diaeiv  
    8589      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     90      CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 
    8691# else 
    8792      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
     
    160165         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current 
    161166         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current 
    162          IF( iom_use('ueiv_heattr') ) THEN 
    163             zztmp = 0.5 * rau0 * rcp  
     167         IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value 
     168           z2d(:,:) = rau0 * e12t(:,:) 
     169           DO jk = 1, jpk 
     170              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     171           END DO 
     172           CALL iom_put( "weiv_masstr" , z3d )   
     173         ENDIF 
     174         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d')        & 
     175                                    .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 
     176            z3d(:,:,jpk) = 0.e0 
     177            z2d(:,:) = 0.e0 
     178            DO jk = 1, jpkm1 
     179               z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     180               z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     181            END DO 
     182            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
     183         ENDIF 
     184 
     185         IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
     186            zztmp = 0.5 * rcp  
    164187            z2d(:,:) = 0.e0  
    165             DO jk = 1, jpkm1 
    166                DO jj = 2, jpjm1 
    167                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                      z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 
    169                        &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk)  
    170                   END DO 
    171                END DO 
    172             END DO 
    173             CALL lbc_lnk( z2d, 'U', -1. ) 
    174             CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
     188            z3d_T(:,:,:) = 0.e0  
     189            DO jk = 1, jpkm1 
     190               DO jj = 2, jpjm1 
     191                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     192                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     193                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     194                  END DO 
     195               END DO 
     196            END DO 
     197            IF (iom_use('ueiv_heattr') ) THEN 
     198               CALL lbc_lnk( z2d, 'U', -1. ) 
     199               CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! 2D heat transport in i-direction 
     200            ENDIF 
     201            IF (iom_use('ueiv_heattr3d') ) THEN 
     202               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     203               CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in i-direction 
     204            ENDIF 
     205         ENDIF 
     206 
     207         IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 
     208            zztmp = 0.5 * 0.001 
     209            z2d(:,:) = 0.e0  
     210            z3d_T(:,:,:) = 0.e0  
     211            DO jk = 1, jpkm1 
     212               DO jj = 2, jpjm1 
     213                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     214                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     215                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     216                  END DO 
     217               END DO 
     218            END DO 
     219            IF (iom_use('ueiv_salttr') ) THEN 
     220               CALL lbc_lnk( z2d, 'U', -1. ) 
     221               CALL iom_put( "ueiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     222            ENDIF 
     223            IF (iom_use('ueiv_salttr3d') ) THEN 
     224               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     225               CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     226            ENDIF 
     227         ENDIF 
     228 
     229         IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d')       & 
     230                                    .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 
     231            z3d(:,:,jpk) = 0.e0 
     232            DO jk = 1, jpkm1 
     233               z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     234            END DO 
     235            CALL iom_put( "veiv_masstr", z3d )                  ! mass transport in j-direction 
    175236         ENDIF 
    176237             
    177          IF( iom_use('veiv_heattr') ) THEN 
    178             zztmp = 0.5 * rau0 * rcp  
     238         IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 
     239            zztmp = 0.5 * rcp  
    179240            z2d(:,:) = 0.e0  
    180             DO jk = 1, jpkm1 
    181                DO jj = 2, jpjm1 
    182                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                      z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 
    184                      &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk)  
    185                   END DO 
    186                END DO 
    187             END DO 
    188             CALL lbc_lnk( z2d, 'V', -1. ) 
    189             CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in i-direction 
    190          ENDIF 
     241            z3d_T(:,:,:) = 0.e0  
     242            DO jk = 1, jpkm1 
     243               DO jj = 2, jpjm1 
     244                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     245                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     246                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     247                  END DO 
     248               END DO 
     249            END DO 
     250            IF (iom_use('veiv_heattr') ) THEN 
     251               CALL lbc_lnk( z2d, 'V', -1. ) 
     252               CALL iom_put( "veiv_heattr", zztmp * z2d )                  ! 2D heat transport in j-direction 
     253            ENDIF 
     254            IF (iom_use('veiv_heattr3d') ) THEN 
     255               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     256               CALL iom_put( "veiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in j-direction 
     257            ENDIF 
     258         ENDIF 
     259 
     260         IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 
     261            zztmp = 0.5 * 0.001 
     262            z2d(:,:) = 0.e0  
     263            z3d_T(:,:,:) = 0.e0  
     264            DO jk = 1, jpkm1 
     265               DO jj = 2, jpjm1 
     266                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     267                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     268                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 
     269                  END DO 
     270               END DO 
     271            END DO 
     272            IF (iom_use('veiv_salttr') ) THEN 
     273               CALL lbc_lnk( z2d, 'V', -1. ) 
     274               CALL iom_put( "veiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     275            ENDIF 
     276            IF (iom_use('veiv_salttr3d') ) THEN 
     277               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     278               CALL iom_put( "veiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     279            ENDIF 
     280         ENDIF 
     281 
     282         IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN   ! vertical mass transport & its square value 
     283           z2d(:,:) = rau0 * e12t(:,:) 
     284           DO jk = 1, jpk 
     285              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     286           END DO 
     287           CALL iom_put( "weiv_masstr" , z3d )                  ! mass transport in k-direction 
     288         ENDIF 
     289 
     290         IF( iom_use('weiv_heattr3d') ) THEN 
     291            zztmp = 0.5 * rcp  
     292            DO jk = 1, jpkm1 
     293               DO jj = 2, jpjm1 
     294                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     295                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 
     296                  END DO 
     297               END DO 
     298            END DO 
     299            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     300            CALL iom_put( "weiv_heattr3d", zztmp * z3d_T )                 ! 3D heat transport in k-direction 
     301         ENDIF 
     302 
     303         IF( iom_use('weiv_salttr3d') ) THEN 
     304            zztmp = 0.5 * 0.001  
     305            DO jk = 1, jpkm1 
     306               DO jj = 2, jpjm1 
     307                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     308                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 
     309                  END DO 
     310               END DO 
     311            END DO 
     312            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     313            CALL iom_put( "weiv_salttr3d", zztmp * z3d_T )                 ! 3D salt transport in k-direction 
     314         ENDIF 
     315 
    191316    END IF 
     317! 
     318    IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 
     319       z3d(:,:,:) = 0._wp 
     320       DO jk = 1, jpkm1 
     321          DO jj = 2, jpjm1 
     322             DO ji = fs_2, fs_jpim1   ! vector opt. 
     323                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 
     324                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     325             END DO 
     326          END DO 
     327       END DO 
     328       CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 
     329       z3d(:,:,:) = 0._wp 
     330       DO jk = 1, jpkm1 
     331          DO jj = 2, jpjm1 
     332             DO ji = fs_2, fs_jpim1   ! vector opt. 
     333                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 
     334                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     335             END DO 
     336          END DO 
     337       END DO 
     338       CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 
     339    ENDIF 
     340 
     341    IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 
    192342# endif   
    193       !  
     343