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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13193 for NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src – NEMO

Ignore:
Timestamp:
2020-07-01T15:42:06+02:00 (4 years ago)
Author:
smasson
Message:

better e3: update with trunk@13136 see #2385

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3
Files:
53 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@12931        sette 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ABL/ablmod.F90

    r12724 r13193  
    592592      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    593593      !                            !  8 *** Swap time indices for the next timestep 
    594       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    595       nt_n = 1 + MOD( kt  , 2) 
    596       nt_a = 1 + MOD( kt+1, 2) 
    597       !     
     594      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     595      nt_n = 1 + MOD( nt_n, 2) 
     596      nt_a = 1 + MOD( nt_a, 2) 
     597      ! 
    598598!--------------------------------------------------------------------------------------------------- 
    599599   END SUBROUTINE abl_stp 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ABL/par_abl.F90

    r12724 r13193  
    2929   LOGICAL , PUBLIC            ::   ln_smth_pblh   !: smoothing of atmospheric PBL height  
    3030 
     31   LOGICAL           , PUBLIC ::   ln_rstart_abl    !: (de)activate abl restart 
    3132   CHARACTER(len=256), PUBLIC ::   cn_ablrst_in     !: suffix of abl restart name (input) 
    3233   CHARACTER(len=256), PUBLIC ::   cn_ablrst_out    !: suffix of abl restart name (output) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ABL/sbcabl.F90

    r12724 r13193  
    6868      LOGICAL            ::   lluldl 
    6969      NAMELIST/namsbc_abl/ cn_dir, cn_dom, cn_ablrst_in, cn_ablrst_out,           & 
    70          &                 cn_ablrst_indir, cn_ablrst_outdir,                     & 
     70         &                 cn_ablrst_indir, cn_ablrst_outdir, ln_rstart_abl,      & 
    7171         &                 ln_hpgls_frc, ln_geos_winds, nn_dyn_restore,           & 
    7272         &                 rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max,   & 
    … …  
    263263 
    264264      ! Initialize the time index for now time (nt_n) and after time (nt_a) 
    265       nt_n = 1 + MOD( nit000  , 2) 
    266       nt_a = 1 + MOD( nit000+1, 2) 
     265      nt_n = 1; nt_a = 2 
    267266 
    268267      ! initialize ABL from data or restart 
    269       IF( ln_rstart ) THEN 
     268      IF( ln_rstart_abl ) THEN 
    270269         CALL abl_rst_read 
    271270      ELSE 
    … …  
    288287      ENDIF 
    289288 
    290       rhoa(:,:) = rho_air( tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), sf(jp_slp)%fnow(:,:,1) ) !!GS: rhoa must be (re)computed here here to avoid division by zero in blk_ice_1 (TBI) 
    291  
    292289   END SUBROUTINE sbc_abl_init 
    293290 
    … …  
    329326      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    330327 
    331       !!------------------------------------------------------------------------------------------- 
    332       !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
    333       !!------------------------------------------------------------------------------------------- 
    334  
    335       CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
    336          &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    337          &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
    338          &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    339          &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
    340  
    341 #if defined key_si3 
    342       CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in 
    343          &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in 
    344          &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in 
    345          &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out 
    346 #endif 
    347  
    348       !!------------------------------------------------------------------------------------------- 
    349       !! 3 - Advance ABL variables from now (n) to after (n+1) 
    350       !!------------------------------------------------------------------------------------------- 
    351  
    352       CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in 
    353          &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in 
    354          &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in 
    355          &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in 
    356          &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in 
    357          &              zcd_du, zsen, zevp,                                 &   !   <=> in/out 
    358          &              wndm, utau, vtau, taum                              &   !   =>> out 
    359 #if defined key_si3 
    360          &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in 
    361          &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in 
    362          &            , utau_ice, vtau_ice                                  &   !   =>> out 
    363 #endif 
    364          &                                                                  ) 
    365       !!------------------------------------------------------------------------------------------- 
    366       !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 
    367       !!                                                                time swap is done in abl_stp 
    368       !!------------------------------------------------------------------------------------------- 
    369  
    370       CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
    371          &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
    372          &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
    373          &            tsk_m, zsen, zevp                                ) 
    374  
    375       CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) 
    376       IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file 
    377  
    378 #if defined key_si3 
    379       ! Avoid a USE abl in icesbc module 
    380       sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 
    381 #endif 
     328      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     329 
     330         !!------------------------------------------------------------------------------------------- 
     331         !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 
     332         !!------------------------------------------------------------------------------------------- 
     333 
     334         CALL blk_oce_1( kt,  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),   &   !   <<= in 
     335            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
     336            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     337            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
     338            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
     339 
     340#if defined key_si3 
     341         CALL blk_ice_1(  u_abl(:,:,2,nt_n      ),  v_abl(:,:,2,nt_n      ),    &   !   <<= in 
     342            &            tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),    &   !   <<= in 
     343            &            sf(jp_slp)%fnow(:,:,1)  ,  u_ice, v_ice, tm_su    ,    &   !   <<= in 
     344            &            pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui )   !   <<= out 
     345#endif 
     346 
     347         !!------------------------------------------------------------------------------------------- 
     348         !! 3 - Advance ABL variables from now (n) to after (n+1) 
     349         !!------------------------------------------------------------------------------------------- 
     350    
     351         CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq,                          &   !   <<= in 
     352            &              sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:),   &   !   <<= in 
     353            &              sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:),   &   !   <<= in 
     354            &              sf(jp_slp )%fnow(:,:,1),                            &   !   <<= in 
     355            &              sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:),   &   !   <<= in 
     356            &              zcd_du, zsen, zevp,                                 &   !   <=> in/out 
     357            &              wndm, utau, vtau, taum                              &   !   =>> out 
     358#if defined key_si3 
     359            &            , tm_su, u_ice, v_ice, zssqi, zcd_dui                 &   !   <<= in 
     360            &            , zseni, zevpi, wndm_ice, ato_i                       &   !   <<= in 
     361            &            , utau_ice, vtau_ice                                  &   !   =>> out 
     362#endif 
     363            &                                                                  ) 
     364         !!------------------------------------------------------------------------------------------- 
     365         !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 
     366         !!                                                                time swap is done in abl_stp 
     367         !!------------------------------------------------------------------------------------------- 
     368 
     369         CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta),                            & 
     370            &            sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1),   & 
     371            &            sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1),   & 
     372            &            tsk_m, zsen, zevp                                ) 
     373    
     374         CALL abl_rst_opn( kt )                       ! Open abl restart file (if necessary) 
     375         IF( lrst_abl ) CALL abl_rst_write( kt )      ! -- abl restart file 
     376 
     377#if defined key_si3 
     378         ! Avoid a USE abl in icesbc module 
     379         sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta);  sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 
     380#endif 
     381      END IF 
    382382 
    383383   END SUBROUTINE sbc_abl 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90

    r12724 r13193  
    179179            ! 
    180180            ! -- mandatory fields -- ! 
    181             zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 
    182             zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 
    183             zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 
     181            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
     182            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
     183            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
    184184 
    185185            ! -- optional fields -- ! 
    … …  
    219219               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    220220            ! 
    221             zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 
    222             ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 
    223             zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 
    224             ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 
    225             zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
    226             zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     221            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     222            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
     223            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
     224            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
     225            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
     226            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
    227227            ! 
    228228            ! change the switch for the following 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydta.F90

    r12724 r13193  
    9292      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices 
    9393      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers 
    94       INTEGER,   DIMENSION(jpbgrd)     ::   ilen1  
    9594      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut 
    9695      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias 
    … …  
    117116                  END DO 
    118117               ENDIF 
    119                IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer 
     118               IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    120119                  igrd = 2 
    121                   DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)   ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 
     120                  DO ib = 1, SIZE(dta_bdy(jbdy)%u2d)      ! u2d is used either over the whole bdy or only on the rim 
    122121                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    123122                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    124123                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)          
    125124                  END DO 
     125               ENDIF 
     126               IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
    126127                  igrd = 3 
    127                   DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)   ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init 
     128                  DO ib = 1, SIZE(dta_bdy(jbdy)%v2d)      ! v2d is used either over the whole bdy or only on the rim 
    128129                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    129130                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    211212         ! 
    212213         ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 
    213          IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN   ! runoff and we read u/v2d 
     214         IF( cn_tra(jbdy) == 'runoff' ) THEN   ! runoff 
    214215            ! 
    215             igrd = 2                      ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
    216             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    217                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    218                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    219                dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    220             END DO 
    221             igrd = 3                      ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
    222             DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    223                ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    224                ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    225                dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    226             END DO 
     216            IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     217               igrd = 2                         ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 
     218               DO ib = 1, SIZE(dta_alias%u2d)   ! u2d is used either over the whole bdy or only on the rim 
     219                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     220                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     221                  dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     222               END DO 
     223            ENDIF 
     224            IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN   ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 
     225               igrd = 3                         ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 
     226               DO ib = 1, SIZE(dta_alias%v2d)   ! v2d is used either over the whole bdy or only on the rim 
     227                  ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
     228                  ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     229                  dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     230               END DO 
     231            ENDIF 
    227232         ENDIF 
    228233 
    229234         ! tidal harmonic forcing ONLY: initialise arrays 
    230235         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d  
    231             IF( dta_alias%lneed_ssh   .AND. ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 
    232             IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 
    233             IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 
     236            IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 
     237            IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 
     238            IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 
    234239         ENDIF 
    235240 
    … …  
    333338            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop 
    334339               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    335                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=idx_bdy(jbdy)%nblen(:) 
    336                   ELSE                                 ;   ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 
    337                   ENDIF 
    338                   IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
    339                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
    340                   IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
     340                  IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 
     341                  IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 
     342                  IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 
    341343               ENDIF 
    342344            END DO 
    343345         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    344346            ! 
    345             ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step 
    346347            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 
    347348         ENDIF 
    … …  
    351352      ! 
    352353   END SUBROUTINE bdy_dta 
    353  
     354    
    354355 
    355356   SUBROUTINE bdy_dta_init 
    … …  
    383384      LOGICAL                                ::   llneed        ! 
    384385      LOGICAL                                ::   llread        ! 
     386      LOGICAL                                ::   llfullbdy     ! 
    385387      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    386388      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    … …  
    497499               igrd = 2                                                    ! U point 
    498500               ipk = 1                                                     ! surface data 
    499                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     501               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%u2d will be needed 
    500502               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get u2d from u3d and read NetCDF file 
    501503               bf_alias => bf(jp_bdyu2d,jbdy:jbdy)                         ! alias for u2d structure of bdy number jbdy 
    502504               bn_alias => bn_u2d                                          ! alias for u2d structure of nambdy_dta 
    503                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from u3d -> need on the full bdy 
    504                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     505               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need u2d over the whole bdy or only over the rim? 
     506               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     507               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    505508               ENDIF 
    506509            ENDIF 
    … …  
    509512               igrd = 3                                                    ! V point 
    510513               ipk = 1                                                     ! surface data 
    511                llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%ssh will be needed 
     514               llneed = dta_bdy(jbdy)%lneed_dyn2d                          ! dta_bdy(jbdy)%v2d will be needed 
    512515               llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1   ! don't get v2d from v3d and read NetCDF file 
    513516               bf_alias => bf(jp_bdyv2d,jbdy:jbdy)                         ! alias for v2d structure of bdy number jbdy 
    514517               bn_alias => bn_v2d                                          ! alias for v2d structure of nambdy_dta  
    515                IF( ln_full_vel ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd)      ! will be computed from v3d -> need on the full bdy 
    516                ELSE                    ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd)   ! used only on the rim 
     518               llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs'        ! need v2d over the whole bdy or only over the rim? 
     519               IF( llfullbdy ) THEN  ;   iszdim = idx_bdy(jbdy)%nblen(igrd) 
     520               ELSE                  ;   iszdim = idx_bdy(jbdy)%nblenrim(igrd) 
    517521               ENDIF 
    518522            ENDIF 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdyini.F90

    r12377 r13193  
    1919   USE oce            ! ocean dynamics and tracers variables 
    2020   USE dom_oce        ! ocean space and time domain 
     21   USE sbc_oce , ONLY: nn_ice 
    2122   USE bdy_oce        ! unstructured open boundary conditions 
    2223   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
    2324   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
    2425   USE tide_mod, ONLY: ln_tide ! tidal forcing 
    25    USE phycst   , ONLY: rday 
     26   USE phycst  , ONLY: rday 
    2627   ! 
    2728   USE in_out_manager ! I/O units 
    … …  
    315316 
    316317         dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 
     318 
     319         IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 
     320            WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 
     321            CALL ctl_stop( ctmp1 ) 
     322         ENDIF 
    317323 
    318324         IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN  

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdytides.F90

    r12724 r13193  
    6565      !! namelist variables 
    6666      !!------------------- 
    67       CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files 
    68       LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data 
     67      CHARACTER(len=80)                         ::   filtide             ! Filename root for tidal input files 
     68      LOGICAL                                   ::   ln_bdytide_2ddta    ! If true, read 2d harmonic data 
    6969      !! 
    70       INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices 
    71       INTEGER                                   ::   ii, ij              !: dummy loop indices 
     70      INTEGER                                   ::   ib_bdy, itide, ib   ! dummy loop indices 
     71      INTEGER                                   ::   ii, ij              ! dummy loop indices 
    7272      INTEGER                                   ::   inum, igrd 
    73       INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays) 
     73      INTEGER                                   ::   isz                 ! bdy data size 
    7474      INTEGER                                   ::   ios                 ! Local integer output status for namelist read 
    7575      INTEGER                                   ::   nbdy_rdstart, nbdy_loc 
    76       CHARACTER(LEN=50)                         ::   cerrmsg             !: error string 
    77       CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file  
    78       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data 
    79       REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !:  "     "    "   "   "   "        "      "  
     76      CHARACTER(LEN=50)                         ::   cerrmsg             ! error string 
     77      CHARACTER(len=80)                         ::   clfile              ! full file name for tidal input file  
     78      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            ! work space to read in tidal harmonics data 
     79      REAL(wp),ALLOCATABLE, DIMENSION(:,:)      ::   ztr, zti            !  "     "    "   "   "   "        "      "  
    8080      !! 
    81       TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut    
     81      TYPE(TIDES_DATA), POINTER                 ::   td                  ! local short cut    
     82      TYPE(  OBC_DATA), POINTER                 ::   dta                 ! local short cut 
    8283      !! 
    8384      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta 
    … …  
    9394         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    9495            ! 
    95             td => tides(ib_bdy) 
    96  
     96            td  => tides(ib_bdy) 
     97            dta => dta_bdy(ib_bdy) 
     98          
    9799            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    98100            filtide(:) = '' 
    … …  
    130132            IF(lwp) WRITE(numout,*) ' ' 
    131133 
    132             ! Allocate space for tidal harmonics data - get size from OBC data arrays 
     134            ! Allocate space for tidal harmonics data - get size from BDY data arrays 
     135            ! Allocate also slow varying data in the case of time splitting: 
     136            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    133137            ! ----------------------------------------------------------------------- 
    134  
    135             ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    136             ! relaxation area       
    137             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = idx_bdy(ib_bdy)%nblen   (:) 
    138             ELSE                                   ;   ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 
    139             ENDIF 
    140  
    141             ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 
    142             ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 
    143  
    144             ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 
    145             ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 
    146  
    147             ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 
    148             ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 
    149  
    150             td%ssh0(:,:,:) = 0._wp 
    151             td%ssh (:,:,:) = 0._wp 
    152             td%u0  (:,:,:) = 0._wp 
    153             td%u   (:,:,:) = 0._wp 
    154             td%v0  (:,:,:) = 0._wp 
    155             td%v   (:,:,:) = 0._wp 
    156  
     138            IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     139               isz = SIZE(dta%ssh) 
     140               ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 
     141               dta_bdy_s(ib_bdy)%ssh(:) = 0._wp   ! needed? 
     142            ENDIF 
     143            IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     144               isz = SIZE(dta%u2d) 
     145               ALLOCATE( td%u0  ( isz, nb_harmo, 2 ), td%u  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 
     146               dta_bdy_s(ib_bdy)%u2d(:) = 0._wp   ! needed? 
     147            ENDIF 
     148            IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     149               isz = SIZE(dta%v2d) 
     150               ALLOCATE( td%v0  ( isz, nb_harmo, 2 ), td%v  ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 
     151               dta_bdy_s(ib_bdy)%v2d(:) = 0._wp   ! needed? 
     152            ENDIF 
     153 
     154            ! fill td%ssh0, td%u0, td%v0 
     155            ! ----------------------------------------------------------------------- 
    157156            IF( ln_bdytide_2ddta ) THEN 
     157               ! 
    158158               ! It is assumed that each data file contains all complex harmonic amplitudes 
    159159               ! given on the global domain (ie global, jpiglo x jpjglo) 
    … …  
    162162               ! 
    163163               ! SSH fields 
    164                clfile = TRIM(filtide)//'_grid_T.nc' 
    165                CALL iom_open( clfile , inum )  
    166                igrd = 1                       ! Everything is at T-points here 
    167                DO itide = 1, nb_harmo 
    168                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    169                   CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    170                   DO ib = 1, ilen0(igrd) 
    171                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    172                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    173                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    174                      td%ssh0(ib,itide,1) = ztr(ii,ij) 
    175                      td%ssh0(ib,itide,2) = zti(ii,ij) 
    176                   END DO 
    177                END DO  
    178                CALL iom_close( inum ) 
     164               IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     165                  clfile = TRIM(filtide)//'_grid_T.nc' 
     166                  CALL iom_open( clfile , inum )  
     167                  igrd = 1                       ! Everything is at T-points here 
     168                  DO itide = 1, nb_harmo 
     169                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     170                     CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
     171                     DO ib = 1, SIZE(dta%ssh) 
     172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     173                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     174                        td%ssh0(ib,itide,1) = ztr(ii,ij) 
     175                        td%ssh0(ib,itide,2) = zti(ii,ij) 
     176                     END DO 
     177                  END DO 
     178                  CALL iom_close( inum ) 
     179               ENDIF 
    179180               ! 
    180181               ! U fields 
    181                clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open( clfile , inum )  
    183                igrd = 2                       ! Everything is at U-points here 
    184                DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
    187                   DO ib = 1, ilen0(igrd) 
    188                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    189                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    190                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    191                      td%u0(ib,itide,1) = ztr(ii,ij) 
    192                      td%u0(ib,itide,2) = zti(ii,ij) 
    193                   END DO 
    194                END DO 
    195                CALL iom_close( inum ) 
     182               IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     183                  clfile = TRIM(filtide)//'_grid_U.nc' 
     184                  CALL iom_open( clfile , inum )  
     185                  igrd = 2                       ! Everything is at U-points here 
     186                  DO itide = 1, nb_harmo 
     187                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
     188                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
     189                     DO ib = 1, SIZE(dta%u2d) 
     190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     191                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     192                        td%u0(ib,itide,1) = ztr(ii,ij) 
     193                        td%u0(ib,itide,2) = zti(ii,ij) 
     194                     END DO 
     195                  END DO 
     196                  CALL iom_close( inum ) 
     197               ENDIF 
    196198               ! 
    197199               ! V fields 
    198                clfile = TRIM(filtide)//'_grid_V.nc' 
    199                CALL iom_open( clfile , inum )  
    200                igrd = 3                       ! Everything is at V-points here 
    201                DO itide = 1, nb_harmo 
    202                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
    203                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
    204                   DO ib = 1, ilen0(igrd) 
    205                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    206                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    207                      IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    208                      td%v0(ib,itide,1) = ztr(ii,ij) 
    209                      td%v0(ib,itide,2) = zti(ii,ij) 
    210                   END DO 
    211                END DO   
    212                CALL iom_close( inum ) 
     200               IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     201                  clfile = TRIM(filtide)//'_grid_V.nc' 
     202                  CALL iom_open( clfile , inum )  
     203                  igrd = 3                       ! Everything is at V-points here 
     204                  DO itide = 1, nb_harmo 
     205                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
     206                     CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
     207                     DO ib = 1, SIZE(dta%v2d) 
     208                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     209                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     210                        td%v0(ib,itide,1) = ztr(ii,ij) 
     211                        td%v0(ib,itide,2) = zti(ii,ij) 
     212                     END DO 
     213                  END DO 
     214                  CALL iom_close( inum ) 
     215               ENDIF 
    213216               ! 
    214217               DEALLOCATE( ztr, zti )  
    … …  
    218221               ! Read tidal data only on bdy segments 
    219222               !  
    220                ALLOCATE( dta_read( MAXVAL(ilen0(1:3)), 1, 1 ) ) 
     223               ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 
    221224               ! 
    222225               ! Open files and read in tidal forcing data 
    … …  
    225228               DO itide = 1, nb_harmo 
    226229                  !                                                              ! SSH fields 
    227                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
    228                   CALL iom_open( clfile, inum ) 
    229                   CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    230                   td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 
    231                   CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
    232                   td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 
    233                   CALL iom_close( inum ) 
     230                  IF( ASSOCIATED(dta%ssh) ) THEN   ! we use bdy ssh on this mpi subdomain 
     231                     isz = SIZE(dta%ssh) 
     232                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
     233                     CALL iom_open( clfile, inum ) 
     234                     CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     235                     td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 
     236                     CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     237                     td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 
     238                     CALL iom_close( inum ) 
     239                  ENDIF 
    234240                  !                                                              ! U fields 
    235                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
    236                   CALL iom_open( clfile, inum ) 
    237                   CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    238                   td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 
    239                   CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
    240                   td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 
    241                   CALL iom_close( inum ) 
     241                  IF( ASSOCIATED(dta%u2d) ) THEN   ! we use bdy u2d on this mpi subdomain 
     242                     isz = SIZE(dta%u2d) 
     243                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
     244                     CALL iom_open( clfile, inum ) 
     245                     CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     246                     td%u0(:,itide,1) = dta_read(1:isz,1,1) 
     247                     CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     248                     td%u0(:,itide,2) = dta_read(1:isz,1,1) 
     249                     CALL iom_close( inum ) 
     250                  ENDIF 
    242251                  !                                                              ! V fields 
    243                   clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
    244                   CALL iom_open( clfile, inum ) 
    245                   CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    246                   td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 
    247                   CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
    248                   td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 
    249                   CALL iom_close( inum ) 
     252                  IF( ASSOCIATED(dta%v2d) ) THEN   ! we use bdy v2d on this mpi subdomain 
     253                     isz = SIZE(dta%v2d) 
     254                     clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
     255                     CALL iom_open( clfile, inum ) 
     256                     CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     257                     td%v0(:,itide,1) = dta_read(1:isz,1,1) 
     258                     CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     259                     td%v0(:,itide,2) = dta_read(1:isz,1,1) 
     260                     CALL iom_close( inum ) 
     261                  ENDIF 
    250262                  ! 
    251263               END DO ! end loop on tidal components 
    … …  
    254266               ! 
    255267            ENDIF ! ln_bdytide_2ddta=.true. 
    256             ! 
    257             ! Allocate slow varying data in the case of time splitting: 
    258             ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
    259             ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
    260             ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    261             ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    262             dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 
    263             dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 
    264             dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    265268            ! 
    266269         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
    … …  
    283286      ! 
    284287      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    285       INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
    286       INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
    287       INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
     288      INTEGER  ::   itide, ib_bdy, ib         ! loop indices 
    288289      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset    
    289290      !!---------------------------------------------------------------------- 
    … …  
    310311         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
    311312            ! 
    312             nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    313             nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    314             ! 
    315             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
    316             ELSE                                   ;   ilen0(:) = nblenrim(:) 
    317             ENDIF      
    318             ! 
    319313            ! We refresh nodal factors every day below 
    320314            ! This should be done somewhere else 
    … …  
    337331            ! If time splitting, initialize arrays from slow varying open boundary data: 
    338332            IF ( PRESENT(kit) ) THEN            
    339                IF ( dta_bdy(ib_bdy)%lneed_ssh   ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    340                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    341                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     333               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 
     334               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 
     335               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 
    342336            ENDIF 
    343337            ! 
    … …  
    349343               z_sist = zramp * SIN( z_sarg ) 
    350344               ! 
    351                IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 
    352                   igrd=1                              ! SSH on tracer grid 
    353                   DO ib = 1, ilen0(igrd) 
     345               IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN   ! SSH on tracer grid 
     346                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 
    354347                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
    355348                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
    … …  
    358351               ENDIF 
    359352               ! 
    360                IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 
    361                   igrd=2                              ! U grid 
    362                   DO ib = 1, ilen0(igrd) 
     353               IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN  ! U grid 
     354                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 
    363355                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
    364356                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
    365357                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    366358                  END DO 
    367                   igrd=3                              ! V grid 
    368                   DO ib = 1, ilen0(igrd)  
     359               ENDIF 
     360               ! 
     361               IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN   ! V grid 
     362                  DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 
    369363                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
    370364                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
    … …  
    372366                  END DO 
    373367               ENDIF 
     368               ! 
    374369            END DO              
    375          END IF 
     370         ENDIF 
    376371      END DO 
    377372      ! 
    … …  
    386381      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    387382      ! 
    388       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    389       INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays) 
     383      INTEGER ::   itide, isz, ib       ! dummy loop indices 
    390384      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    391385      !!---------------------------------------------------------------------- 
    392386      ! 
    393       igrd=1    
    394                               ! SSH on tracer grid. 
    395       ilen0(1) =  SIZE(td%ssh0(:,1,1)) 
    396       ! 
    397       ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 
    398       ! 
    399       DO itide = 1, nb_harmo 
    400          DO ib = 1, ilen0(igrd) 
    401             mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 
    402             phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     387      IF( ASSOCIATED(td%ssh0) ) THEN   ! SSH on tracer grid. 
     388         ! 
     389         isz = SIZE( td%ssh0, dim = 1 ) 
     390         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     391         ! 
     392         DO itide = 1, nb_harmo 
     393            DO ib = 1, isz 
     394               mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 
     395               phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 
     396            END DO 
     397            DO ib = 1, isz 
     398               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     399               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
     400            END DO 
     401            DO ib = 1, isz 
     402               td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     403               td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     404            END DO 
    403405         END DO 
    404          DO ib = 1 , ilen0(igrd) 
    405             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    406             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
    407          ENDDO 
    408          DO ib = 1 , ilen0(igrd) 
    409             td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    410             td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    411          ENDDO 
    412       END DO 
    413       ! 
    414       DEALLOCATE( mod_tide, phi_tide ) 
     406         ! 
     407         DEALLOCATE( mod_tide, phi_tide ) 
     408         ! 
     409      ENDIF 
    415410      ! 
    416411   END SUBROUTINE tide_init_elevation 
    … …  
    424419      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
    425420      ! 
    426       INTEGER ::   itide, igrd, ib       ! dummy loop indices 
    427       INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays) 
     421      INTEGER ::   itide, isz, ib        ! dummy loop indices 
    428422      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    429423      !!---------------------------------------------------------------------- 
    430424      ! 
    431       ilen0(2) =  SIZE(td%u0(:,1,1)) 
    432       ilen0(3) =  SIZE(td%v0(:,1,1)) 
    433       ! 
    434       igrd=2                                 ! U grid. 
    435       ! 
    436       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    437       ! 
    438       DO itide = 1, nb_harmo 
    439          DO ib = 1, ilen0(igrd) 
    440             mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 
    441             phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     425      IF( ASSOCIATED(td%u0) ) THEN   ! U grid. we use bdy u2d on this mpi subdomain 
     426         ! 
     427         isz = SIZE( td%u0, dim = 1 ) 
     428         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     429         ! 
     430         DO itide = 1, nb_harmo 
     431            DO ib = 1, isz 
     432               mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 
     433               phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 
     434            END DO 
     435            DO ib = 1, isz 
     436               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     437               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     438            END DO 
     439            DO ib = 1, isz 
     440               td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     441               td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     442            END DO 
    442443         END DO 
    443          DO ib = 1, ilen0(igrd) 
    444             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    445             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    446          ENDDO 
    447          DO ib = 1, ilen0(igrd) 
    448             td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    449             td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    450          ENDDO 
    451       END DO 
    452       ! 
    453       DEALLOCATE( mod_tide , phi_tide ) 
    454       ! 
    455       igrd=3                                 ! V grid. 
    456       ! 
    457       ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    458  
    459       DO itide = 1, nb_harmo 
    460          DO ib = 1, ilen0(igrd) 
    461             mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 
    462             phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     444         ! 
     445         DEALLOCATE( mod_tide, phi_tide ) 
     446         ! 
     447      ENDIF 
     448      ! 
     449      IF( ASSOCIATED(td%v0) ) THEN   ! V grid. we use bdy u2d on this mpi subdomain 
     450         ! 
     451         isz = SIZE( td%v0, dim = 1 ) 
     452         ALLOCATE( mod_tide(isz), phi_tide(isz) ) 
     453         ! 
     454         DO itide = 1, nb_harmo 
     455            DO ib = 1, isz 
     456               mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 
     457               phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 
     458            END DO 
     459            DO ib = 1, isz 
     460               mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     461               phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
     462            END DO 
     463            DO ib = 1, isz 
     464               td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
     465               td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
     466            END DO 
    463467         END DO 
    464          DO ib = 1, ilen0(igrd) 
    465             mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
    466             phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    467          ENDDO 
    468          DO ib = 1, ilen0(igrd) 
    469             td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 
    470             td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 
    471          ENDDO 
    472       END DO 
    473       ! 
    474       DEALLOCATE( mod_tide, phi_tide ) 
    475       ! 
    476   END SUBROUTINE tide_init_velocities 
     468         ! 
     469         DEALLOCATE( mod_tide, phi_tide ) 
     470         ! 
     471      ENDIF 
     472      ! 
     473   END SUBROUTINE tide_init_velocities 
    477474 
    478475   !!====================================================================== 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/C1D/step_c1d.F90

    r12680 r13193  
    2727   PRIVATE 
    2828 
    29    PUBLIC stp_c1d      ! called by opa.F90 
     29   PUBLIC stp_c1d      ! called by nemogcm.F90 
    3030 
    3131   !!---------------------------------------------------------------------- 
    … …  
    5656      ! 
    5757      INTEGER ::   jk       ! dummy loop indice 
    58       INTEGER ::   indic    ! error indicator if < 0 
    5958      !! --------------------------------------------------------------------- 
    60  
    61                              indic = 0                ! reset to no error condition 
    6259      IF( kstp == nit000 )   CALL iom_init( "nemo")   ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    6360      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    … …  
    8885      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8986                         CALL dia_wri( kstp, Nnn )  ! ocean model: outputs 
    90       IF( lk_diahth  )   CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
     87                         CALL dia_hth( kstp, Nnn )  ! Thermocline depth (20°C) 
    9188 
    9289 
    … …  
    111108                        CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) )  ! now potential density for zdfmxl 
    112109      IF( ln_zdfnpc )   CALL tra_npc( kstp,      Nnn, Nrhs, ts, Naa   )         ! applied non penetrative convective adjustment on (t,s) 
    113                         CALL tra_atf( kstp, Nbb, Nnn, Nrhs,     Naa, ts   )     ! time filtering of "now" tracer fields 
    114  
    115  
     110                        CALL tra_atf( kstp, Nbb, Nnn, Naa, ts )                 ! time filtering of "now" tracer arrays 
    116111 
    117112      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    139134      ! Control and restarts 
    140135      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    141                              CALL stp_ctl( kstp, Nnn, indic ) 
     136                             CALL stp_ctl( kstp, Nnn ) 
    142137      IF( kstp == nit000 )   CALL iom_close( numror )          ! close input  ocean restart file 
    143138      IF( lrst_oce       )   CALL rst_write( kstp, Nbb, Nnn )  ! write output ocean restart file 
    144139      ! 
    145140#if defined key_iomput 
    146       IF( kstp == nitend .OR. indic < 0 )   CALL xios_context_finalize()   ! needed for XIOS 
     141      IF( kstp == nitend .OR. nstop > 0 )   CALL xios_context_finalize()   ! needed for XIOS 
    147142      ! 
    148143#endif 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90

    r13156 r13193  
    7676      REAL(wp) ::   zaw, zbw, zrw 
    7777      ! 
    78       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
     78      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh, zbotpres        ! 2D workspace  
    7979      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z2d, zpe                   ! 2D workspace  
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd , zrhop, ztpot, zgdept   ! 3D workspace (zgdept: needed to use the substitute) 
     80      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: z3d, zrhd, ztpot, zgdept   ! 3D workspace (zgdept: needed to use the substitute) 
    8181      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8282 
    … …  
    8888      IF( l_ar5 ) THEN  
    8989         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 
    90          ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
     90         ALLOCATE( zrhd(jpi,jpj,jpk) ) 
    9191         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    9292         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 
    … …  
    163163       
    164164         !                                         ! steric sea surface height 
    165          CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, zgdept )                 ! now in situ and potential density 
    166          zrhop(:,:,jpk) = 0._wp 
    167          CALL iom_put( 'rhop', zrhop ) 
    168          ! 
    169165         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    170166         DO jk = 1, jpkm1 
    171             zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
     167            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 
    172168         END DO 
    173169         IF( ln_linssh ) THEN 
    … …  
    176172                  DO jj = 1,jpj 
    177173                     iks = mikt(ji,jj) 
    178                      zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     174                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 
    179175                  END DO 
    180176               END DO 
    181177            ELSE 
    182                zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
     178               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 
    183179            END IF 
    184180         END IF 
    … …  
    303299      IF( l_ar5 ) THEN 
    304300        DEALLOCATE( zarea_ssh , zbotpres, z2d ) 
    305         DEALLOCATE( zrhd      , zrhop    ) 
    306301        DEALLOCATE( ztsn                 ) 
    307302      ENDIF 
    … …  
    377372      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    378373         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    379          &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     374         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     375         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    380376   
    381377      IF( l_ar5 ) THEN 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90

    r12911 r13193  
    191191         CALL iom_put( "sbs", z2d )                ! bottom salinity 
    192192      ENDIF 
     193 
     194      CALL iom_put( "rhop", rhop(:,:,:) )          ! 3D potential density (sigma0) 
    193195 
    194196      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    … …  
    10331035         CALL iom_close( inum ) 
    10341036      ENDIF 
     1037      ! 
    10351038#endif 
    1036  
    10371039   END SUBROUTINE dia_wri_state 
    10381040 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90

    r12731 r13193  
    1717   !!---------------------------------------------------------------------- 
    1818   !!   Agrif_Root    : dummy function used when lk_agrif=F 
     19   !!   Agrif_Fixed   : dummy function used when lk_agrif=F 
    1920   !!   Agrif_CFixed  : dummy function used when lk_agrif=F 
    2021   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays 
    … …  
    243244   END FUNCTION Agrif_Root 
    244245 
     246   INTEGER FUNCTION Agrif_Fixed() 
     247      Agrif_Fixed = 0 
     248   END FUNCTION Agrif_Fixed 
     249 
    245250   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    246251      Agrif_CFixed = '0' 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dommsk.F90

    r12680 r13193  
    261261               ENDIF 
    262262            END DO 
    263 #if defined key_agrif 
    264             IF( .NOT. AGRIF_Root() ) THEN 
    265                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east 
    266                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west 
    267                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    268                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south 
    269             ENDIF 
    270 #endif 
    271263         END DO 
    272264         ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domvvl.F90

    r12724 r13193  
    915915               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    916916 
    917                DO ji = 1, jpi 
    918                   DO jj = 1, jpj 
    919                      IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
    920                        CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
    921                      ENDIF 
    922                   END DO 
    923                END DO 
     917               DO_2D_11_11 
     918                  IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 
     919                     CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 
     920                  ENDIF 
     921               END_2D 
    924922               ! 
    925923            ELSE 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90

    r12911 r13193  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    … …  
    126125         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    127126         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    128          hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    129          CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
    130 !!gm                                    hdiv(:,:,:) = 0._wp 
    131127 
    132128!!gm POTENTIAL BUG : 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/divhor.F90

    r12590 r13193  
    8585      END_3D 
    8686      ! 
    87 #if defined key_agrif 
    88       IF( .NOT. Agrif_Root() ) THEN 
    89          IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
    90          IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
    91          IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
    92          IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
    93       ENDIF 
    94 #endif 
    95       ! 
    9687      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field) 
    9788      ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynldf_lap_blp.F90

    r12606 r13193  
    7575         DO_2D_01_01 
    7676            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    77 !!gm open question here : e3f  at before or now ?    probably now... 
    78 !!gm note that ahmf has already been multiplied by fmask 
    79             zcur(ji-1,jj-1) =  & 
    80                &      ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)      & 
    81                &  * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    82                &     - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
     77            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
     78               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
     79               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
    8380            !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    84 !!gm note that ahmt has already been multiplied by tmask 
    85             zdiv(ji,jj)     =   & 
    86                &   ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)      & 
    87                &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk)        & 
    88                &        - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
    89                &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk)        & 
    90                &        - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
     81            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)               &   ! ahmt already * by tmask 
     82               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
     83               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
    9184         END_2D 
    9285         ! 
    9386         DO_2D_00_00 
    94             pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                             & 
    95                &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj)   & 
    96                &              / e3u(ji,jj,jk,Kmm)   & 
    97                &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)        ) 
     87            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
     88               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
     89               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                      ) 
    9890               ! 
    99             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                              & 
    100                &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj)   & 
    101                &              / e3v(ji,jj,jk,Kmm)   & 
    102                &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)       ) 
     91            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * (    &    ! * by vmask is mandatory for dyn_ldf_blp use 
     92               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
     93               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                      ) 
    10394         END_2D 
    10495         !                                             ! =============== 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynvor.F90

    r12590 r13193  
    820820         DO_3D_10_10( 1, jpk ) 
    821821            IF(    tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)              & 
    822                & + tmask(ji,jj  ,jk) + tmask(ji+1,jj+1,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
     822               & + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) == 3._wp )   fmask(ji,jj,jk) = 1._wp 
    823823         END_3D 
    824824         ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/sshwzv.F90

    r13167 r13193  
    215215      ENDIF 
    216216      ! 
    217 #if defined key_agrif 
    218       IF( .NOT. AGRIF_Root() ) THEN 
    219          IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east 
    220          IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west 
    221          IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north 
    222          IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south 
    223       ENDIF 
    224 #endif 
     217#if defined key_agrif  
     218      IF( .NOT. AGRIF_Root() ) THEN  
     219         ! Mask vertical velocity at first/last columns/row  
     220         ! inside computational domain (cosmetic)  
     221         ! --- West --- ! 
     222         DO ji = mi0(2), mi1(2) 
     223            DO jj = 1, jpj 
     224               pww(ji,jj,:) = 0._wp  
     225            ENDDO 
     226         ENDDO 
     227         ! 
     228         ! --- East --- ! 
     229         DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 
     230            DO jj = 1, jpj 
     231               pww(ji,jj,:) = 0._wp 
     232            ENDDO 
     233         ENDDO 
     234         ! 
     235         ! --- South --- ! 
     236         DO jj = mj0(2), mj1(2) 
     237            DO ji = 1, jpi 
     238               pww(ji,jj,:) = 0._wp 
     239            ENDDO 
     240         ENDDO 
     241         ! 
     242         ! --- North --- ! 
     243         DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 
     244            DO ji = 1, jpi 
     245               pww(ji,jj,:) = 0._wp 
     246            ENDDO 
     247         ENDDO 
     248      ENDIF  
     249#endif  
    225250      ! 
    226251      IF( ln_timing )   CALL timing_stop('wzv') 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ICB/icbrst.F90

    r12724 r13193  
    188188      ! 
    189189      INTEGER ::   jn   ! dummy loop index 
     190      INTEGER ::   idg  ! number of digits 
    190191      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    191192      CHARACTER(len=256)     :: cl_path 
    192193      CHARACTER(len=256)     :: cl_filename 
    193       CHARACTER(len=256)     :: cl_kt 
     194      CHARACTER(len=8  )     :: cl_kt 
     195      CHARACTER(LEN=12 )     :: clfmt            ! writing format 
    194196      TYPE(iceberg), POINTER :: this 
    195197      TYPE(point)  , POINTER :: pt 
    … …  
    211213         ! file name 
    212214         WRITE(cl_kt, '(i8.8)') kt 
    213          cl_filename = TRIM(cexper)//"_"//TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out) 
     215         cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 
    214216         IF( lk_mpp ) THEN 
    215             WRITE(cl_filename,'(A,"_",I4.4,".nc")') TRIM(cl_filename), narea-1 
     217            idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     218            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     219            WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
    216220         ELSE 
    217             WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename) 
     221            WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    218222         ENDIF 
    219223 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ICB/icbtrj.F90

    r12724 r13193  
    6262      ! 
    6363      INTEGER                ::   iret, iyear, imonth, iday 
     64      INTEGER                ::   idg  ! number of digits 
    6465      REAL(wp)               ::   zfjulday, zsec 
    6566      CHARACTER(len=80)      ::   cl_filename 
    66       CHARACTER(LEN=20)      ::   cldate_ini, cldate_end 
     67      CHARACTER(LEN=12)      ::   clfmt            ! writing format 
     68      CHARACTER(LEN=8 )      ::   cldate_ini, cldate_end 
    6769      TYPE(iceberg), POINTER ::   this 
    6870      TYPE(point)  , POINTER ::   pt 
    … …  
    8082 
    8183      ! define trajectory output name 
    82       IF ( lk_mpp ) THEN   ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")')   & 
    83          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1 
    84       ELSE                 ;   WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A         ,".nc")')   & 
    85          &                        TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)) 
     84      cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 
     85      IF ( lk_mpp ) THEN 
     86         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     87         WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     88         WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
     89      ELSE 
     90         WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    8691      ENDIF 
    8792      IF( lwp .AND. nn_verbose_level >= 0 )   WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/IOM/in_out_manager.F90

    r12377 r13193  
    100100   !!---------------------------------------------------------------------- 
    101101   TYPE :: sn_ctl                !: structure for control over output selection 
    102       LOGICAL :: l_glochk  = .FALSE.  !: range sanity checks are local (F) or global (T) 
    103                                       !  Use global setting for debugging only; 
    104                                       !  local breaches will still be reported 
    105                                       !  and stop the code in most cases. 
    106       LOGICAL :: l_allon   = .FALSE.  !: overall control; activate all following output options 
    107       LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control 
    108                                       !  Note if l_config is True then sn_cfctl%l_allon is ignored. 
    109                                       !  Otherwise setting sn_cfctl%l_allon T/F is equivalent to  
    110                                       !  setting all the following logicals in this structure T/F 
    111                                       !  and disabling subsetting of processors 
    112102      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F) 
    113103      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F) 
    … …  
    169159   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    170160   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
     161!$AGRIF_DO_NOT_TREAT 
     162   INTEGER       ::   ngrdstop = -1         !: grid number having nstop > 1 
     163!$AGRIF_END_DO_NOT_TREAT 
    171164   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 
    172165   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/IOM/iom_def.F90

    r12724 r13193  
    3333   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    3434   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    35    INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
     35   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3636 
    3737 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/IOM/iom_nf90.F90

    r12724 r13193  
    6262      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6363      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     64      CHARACTER(LEN=12 ) ::   clfmt            ! writing format 
    6465      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
     66      INTEGER            ::   idg              ! number of digits 
    6567      INTEGER            ::   iln              ! lengths of character 
    6668      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    109111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    110112            IF( jpnij > 1 ) THEN 
    111                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     113               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     114               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     115               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    112116               cdname = TRIM(cltmp) 
    113117            ENDIF 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdiags.F90

    r12616 r13193  
    8989      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl 
    9090      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d 
    91       CHARACTER(LEN=256), INTENT(in) :: cdvar 
     91      CHARACTER(LEN=*), INTENT(in) :: cdvar 
    9292      !!--------------------------------------------------------------------- 
    9393      INTEGER  :: ji, jj, jk                       ! loop indices 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/LBC/lib_mpp.F90

    r12724 r13193  
    11121112      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5 
    11131113      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10 
     1114      ! 
     1115      CHARACTER(LEN=8) ::   clfmt            ! writing format 
     1116      INTEGER          ::   inum 
    11141117      !!---------------------------------------------------------------------- 
    11151118      ! 
    11161119      nstop = nstop + 1 
    11171120      ! 
    1118       ! force to open ocean.output file if not already opened 
    1119       IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1121      IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN    ! Immediate stop: add an arror message in 'ocean.output' file 
     1122         CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1123         WRITE(inum,*) 
     1124         WRITE(inum,*) ' ==>>>   Look for "E R R O R" messages in all existing *ocean.output* files' 
     1125         CLOSE(inum) 
     1126      ENDIF 
     1127      IF( numout == 6 ) THEN                       ! force to open ocean.output file if not already opened 
     1128         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
     1129      ENDIF 
    11201130      ! 
    11211131                            WRITE(numout,*) 
    … …  
    11451155         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    11461156         WRITE(numout,*)   
     1157         CALL FLUSH(numout) 
     1158         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    11471159         CALL mppstop( ld_abort = .true. ) 
    11481160      ENDIF 
    … …  
    12071219      ! 
    12081220      CHARACTER(len=80) ::   clfile 
     1221      CHARACTER(LEN=10) ::   clfmt            ! writing format 
    12091222      INTEGER           ::   iost 
     1223      INTEGER           ::   idg              ! number of digits 
    12101224      !!---------------------------------------------------------------------- 
    12111225      ! 
    … …  
    12141228      clfile = TRIM(cdfile) 
    12151229      IF( PRESENT( karea ) ) THEN 
    1216          IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
     1230         IF( karea > 1 ) THEN 
     1231            ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 
     1232            idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 )      ! how many digits to we need to write? min=4, max=9 
     1233            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg          ! '(a,a,ix.x)' 
     1234            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 
     1235         ENDIF 
    12171236      ENDIF 
    12181237#if defined key_agrif 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/LBC/mpp_loc_generic.h90

    r10716 r13193  
    3232      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    3333      INDEX_TYPE(:)                                ! index of minimum in global frame 
    34 # if defined key_mpp_mpi 
    3534      ! 
    3635      INTEGER  ::   ierror, ii, idim 
    … …  
    5655         ! 
    5756         kindex(1) = mig( ilocs(1) ) 
    58 #  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
     57#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
    5958         kindex(2) = mjg( ilocs(2) ) 
    60 #  endif 
    61 #  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
     59#endif 
     60#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
    6261         kindex(3) = ilocs(3) 
    63 #  endif 
     62#endif 
    6463         !  
    6564         DEALLOCATE (ilocs) 
    6665         ! 
    6766         index0 = kindex(1)-1   ! 1d index starting at 0 
    68 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     67#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    6968         index0 = index0 + jpiglo * (kindex(2)-1) 
    70 #  endif 
    71 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     69#endif 
     70#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    7271         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    73 #  endif 
     72#endif 
    7473      END IF 
    7574      zain(1,:) = zmin 
    … …  
    7776      ! 
    7877      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
     78#if defined key_mpp_mpi 
    7979      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     80#else 
     81      zaout(:,:) = zain(:,:) 
     82#endif 
    8083      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    8184      ! 
    8285      pmin      = zaout(1,1) 
    8386      index0    = NINT( zaout(2,1) ) 
    84 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     87#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    8588      kindex(3) = index0 / (jpiglo*jpjglo) 
    8689      index0    = index0 - kindex(3) * (jpiglo*jpjglo) 
    87 #  endif 
    88 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     90#endif 
     91#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    8992      kindex(2) = index0 / jpiglo 
    9093      index0 = index0 - kindex(2) * jpiglo 
    91 #  endif 
     94#endif 
    9295      kindex(1) = index0 
    9396      kindex(:) = kindex(:) + 1   ! start indices at 1 
    94 #else 
    95       kindex = 0 ; pmin = 0. 
    96       WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?' 
    97 #endif 
    9897 
    9998   END SUBROUTINE ROUTINE_LOC 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/OBS/obs_grid.F90

    r10068 r13193  
    684684         & fhistx1, fhistx2, fhisty1, fhisty2 
    685685      REAL(wp) :: histtol 
    686        
     686      CHARACTER(LEN=26) :: clfmt            ! writing format 
     687      INTEGER           :: idg              ! number of digits 
     688  
    687689      IF (ln_grid_search_lookup) THEN 
    688690          
    … …  
    709711 
    710712         IF ( ln_grid_global ) THEN 
    711             WRITE(cfname, FMT="(A,'_',A)") & 
    712                &          TRIM(cn_gridsearchfile), 'global.nc' 
     713            WRITE(cfname, FMT="(A,'_',A)") TRIM(cn_gridsearchfile), 'global.nc' 
    713714         ELSE 
    714             WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 
    715                &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj 
     715            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     716            ! define the following format: "(a,a,ix.x,a,ix.x,a,ix.x,a)" 
     717            WRITE(clfmt, "('(a,a,i', i1, '.', i1',a,i', i1, '.', i1',a,i', i1, '.', i1',a)')") idg, idg, idg, idg, idg, idg 
     718            WRITE(cfname,      clfmt     ) TRIM(cn_gridsearchfile),'_', nproc,'of', jpni,'by', jpnj,'.nc' 
    716719         ENDIF 
    717720 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/OBS/obs_write.F90

    r12377 r13193  
    8686      CHARACTER(LEN=40) :: clfname 
    8787      CHARACTER(LEN=10) :: clfiletype 
     88      CHARACTER(LEN=12) :: clfmt            ! writing format 
     89      INTEGER :: idg                        ! number of digits 
    8890      INTEGER :: ilevel 
    8991      INTEGER :: jvar 
    … …  
    181183      fbdata%caddname(1)   = 'Hx' 
    182184 
    183       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     185      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     186      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     187      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    184188 
    185189      IF(lwp) THEN 
    … …  
    326330      CHARACTER(LEN=10) :: clfiletype 
    327331      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
     332      CHARACTER(LEN=12) :: clfmt           ! writing format 
     333      INTEGER :: idg                       ! number of digits 
    328334      INTEGER :: jo 
    329335      INTEGER :: ja 
    … …  
    453459      fbdata%caddname(1)   = 'Hx' 
    454460 
    455       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     461      idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )            ! how many digits to we need to write? min=4, max=9 
     462      WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     463      WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 
    456464 
    457465      IF(lwp) THEN 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcblk.F90

    r12724 r13193  
    627627 
    628628      END SELECT 
    629  
     629       
     630      IF( iom_use('Cd_oce') )   CALL iom_put("Cd_oce",   zcd_oce * tmask(:,:,1)) 
     631      IF( iom_use('Ce_oce') )   CALL iom_put("Ce_oce",   zce_oce * tmask(:,:,1)) 
     632      IF( iom_use('Ch_oce') )   CALL iom_put("Ch_oce",   zch_oce * tmask(:,:,1)) 
     633      !! LB: mainly here for debugging purpose: 
     634      IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 
     635      IF( iom_use('q_zt') )     CALL iom_put("q_zt",     zqair       * tmask(:,:,1)) ! specific humidity       " 
     636      IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 
     637      IF( iom_use('q_zu') )     CALL iom_put("q_zu",     q_zu        * tmask(:,:,1)) ! specific humidity       " 
     638      IF( iom_use('ssq') )      CALL iom_put("ssq",      pssq        * tmask(:,:,1)) ! saturation specific humidity at z=0 
     639      IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu       * tmask(:,:,1)) ! bulk wind speed at z=zu 
     640       
    630641      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    631642         !! ptsk and pssq have been updated!!! 
    … …  
    643654 
    644655      IF( ln_abl ) THEN         !==  ABL formulation  ==!   multiplication by rho_air and turbulent fluxes computation done in ablstp 
    645          !! FL do we need this multiplication by tmask ... ??? 
    646656         DO_2D_11_11 
    647             zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1) 
     657            zztmp = zU_zu(ji,jj) 
    648658            wndm(ji,jj)   = zztmp                   ! Store zU_zu in wndm to compute ustar2 in ablmod 
    649659            pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 
    650660            psen(ji,jj)   = zztmp * zch_oce(ji,jj) 
    651661            pevp(ji,jj)   = zztmp * zce_oce(ji,jj) 
     662            rhoa(ji,jj)   = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) 
    652663         END_2D 
    653664      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
    … …  
    673684         ! ... utau, vtau at U- and V_points, resp. 
    674685         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    675          !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    676          DO_2D_10_10 
     686         !     Note that coastal wind stress is not used in the code... so this extra care has no effect 
     687         DO_2D_00_00 
    677688            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    678689               &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    … …  
    878889         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    879890      ENDIF 
    880  
    881       !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
    882       !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    883  
     891       
     892      IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 
     893      IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 
     894      IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 
     895       
    884896      ! local scalars ( place there for vector optimisation purposes) 
    885       !IF (ln_abl) rhoa  (:,:)  = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI) 
    886897      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
    887898 
    888899      IF( ln_blk ) THEN 
    889          ! ------------------------------------------------------------ ! 
    890          !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    891          ! ------------------------------------------------------------ ! 
    892          ! C-grid ice dynamics :   U & V-points (same as ocean) 
    893          DO_2D_00_00 
    894             putaui(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * zcd_dui(ji+1,jj)             & 
    895                &                      + rhoa(ji  ,jj) * zcd_dui(ji  ,jj)  )          & 
    896                &         * ( 0.5_wp * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) - rn_vfac * puice(ji,jj) ) 
    897             pvtaui(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * zcd_dui(ji,jj+1)             & 
    898                &                      + rhoa(ji,jj  ) * zcd_dui(ji,jj  )  )          & 
    899                &         * ( 0.5_wp * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) - rn_vfac * pvice(ji,jj) ) 
     900         ! ------------------------------------------------------------- ! 
     901         !    Wind stress relative to the moving ice ( U10m - U_ice )    ! 
     902         ! ------------------------------------------------------------- ! 
     903         zztmp1 = rn_vfac * 0.5_wp 
     904         DO_2D_01_01    ! at T point  
     905            putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj  ) + puice(ji,jj) ) ) 
     906            pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji  ,jj-1) + pvice(ji,jj) ) ) 
     907         END_2D 
     908         ! 
     909         DO_2D_00_00    ! U & V-points (same as ocean). 
     910            ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     911            zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     912            zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     913            putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj  ) ) 
     914            pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji  ,jj+1) ) 
    900915         END_2D 
    901916         CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcblk_phy.F90

    r12724 r13193  
    3131   REAL(wp), PARAMETER, PUBLIC :: R_vap   = 461.495_wp  !: Specific gas constant for water vapor          [J/K/kg] 
    3232   REAL(wp), PARAMETER, PUBLIC :: reps0   = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    33    REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     33   REAL(wp), PARAMETER, PUBLIC :: rctv0   = R_vap/R_dry - 1._wp  !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    3434   REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp   !: specific heat of air (only used for ice fluxes now...) 
    3535   REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp   !: transfer coefficient over ice 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbccpl.F90

    r12724 r13193  
    365365      !  
    366366      ! Vectors: change of sign at north fold ONLY if on the local grid 
    367       IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 
     367      IF(       TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice'  & 
     368           .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 
     369 
    368370      IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
    369371       
    … …  
    14821484      INTEGER ::   ji, jj   ! dummy loop indices 
    14831485      INTEGER ::   itx      ! index of taux over ice 
     1486      REAL(wp)                     ::   zztmp1, zztmp2 
    14841487      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
    14851488      !!---------------------------------------------------------------------- 
    … …  
    15451548            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
    15461549            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    1547          CASE( 'F' ) 
    1548             DO_2D_00_00 
    1549                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
    1550                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
    1551             END_2D 
    15521550         CASE( 'T' ) 
    15531551            DO_2D_00_00 
    1554                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
    1555                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
     1552               ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1553               zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     1554               zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     1555               p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
     1556               p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    15561557            END_2D 
    1557          CASE( 'I' ) 
    1558             DO_2D_00_00 
    1559                p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
    1560                p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
    1561             END_2D 
     1558            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    15621559         END SELECT 
    1563          IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN  
    1564             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    1565          ENDIF 
    15661560          
    15671561      ENDIF 
    … …  
    17921786            ENDDO 
    17931787         ELSE 
    1794             qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1788            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17951789            DO jl = 1, jpl 
    1796                zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17971790               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    17981791            END DO 
    … …  
    19351928            END DO 
    19361929         ELSE 
    1937             qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1930            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19381931            DO jl = 1, jpl 
    1939                zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19401932               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    19411933            END DO 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcmod.F90

    r12724 r13193  
    120120      ncom_fsbc = nn_fsbc    ! make nn_fsbc available for lib_mpp 
    121121#endif 
    122       !                             !* overwrite namelist parameter using CPP key information 
    123 #if defined key_agrif 
    124       IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
    125          IF( lk_si3  )   nn_ice      = 2 
    126          IF( lk_cice )   nn_ice      = 3 
    127       ENDIF 
    128 !!GS: TBD 
    129 !#else 
    130 !      IF( lk_si3  )   nn_ice      = 2 
    131 !      IF( lk_cice )   nn_ice      = 3 
    132 #endif 
    133122      ! 
    134123      IF(lwp) THEN                  !* Control print 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcwave.F90

    r12622 r13193  
    212212      END_3D 
    213213      ! 
    214 #if defined key_agrif 
    215       IF( .NOT. Agrif_Root() ) THEN 
    216          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
    217          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
    218          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
    219          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
    220       ENDIF 
    221 #endif 
    222       ! 
    223214      CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 
    224215      ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/STO/stopar.F90

    r12377 r13193  
    684684      !! ** Purpose :   read stochastic parameters from restart file 
    685685      !!---------------------------------------------------------------------- 
    686       INTEGER  :: jsto, jseed 
     686      INTEGER             ::   jsto, jseed 
     687      INTEGER             ::   idg                 ! number of digits 
    687688      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
    688689      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart) 
    689690      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name 
    690691      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name 
    691       CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name 
     692      CHARACTER(LEN=15)   ::   clseed='seed0_0000' ! seed variable name 
     693      CHARACTER(LEN=6)    ::   clfmt               ! writing format 
    692694      !!---------------------------------------------------------------------- 
    693695 
    … …  
    717719         IF (ln_rstseed) THEN 
    718720            ! Get saved state of the random number generator 
     721            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     722            WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg     ! "(ix.x)" 
    719723            DO jseed = 1 , 4 
    720                WRITE(clseed(5:5) ,'(i1.1)') jseed 
    721                WRITE(clseed(7:10),'(i4.4)') narea 
    722                CALL iom_get( numstor, clseed , zrseed(jseed) ) 
     724               WRITE(clseed(5:5)      ,'(i1.1)') jseed 
     725               WRITE(clseed(7:7+idg-1),  clfmt ) narea 
     726               CALL iom_get( numstor, clseed(1:7+idg-1) , zrseed(jseed) ) 
    723727            END DO 
    724728            ziseed = TRANSFER( zrseed , ziseed) 
    … …  
    742746      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    743747      !! 
    744       INTEGER  :: jsto, jseed 
     748      INTEGER             ::   jsto, jseed 
     749      INTEGER             ::   idg                 ! number of digits 
    745750      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
    746751      REAL(KIND=8)        ::   zrseed(4)           ! RNG seeds in real type (with same bits to save in restart) 
    … …  
    749754      CHARACTER(LEN=9)    ::   clsto2d='sto2d_000' ! stochastic parameter variable name 
    750755      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name 
    751       CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name 
     756      CHARACTER(LEN=15)   ::   clseed='seed0_0000' ! seed variable name 
     757      CHARACTER(LEN=6)    ::   clfmt               ! writing format 
    752758      !!---------------------------------------------------------------------- 
    753759 
    … …  
    771777            CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) ) 
    772778            zrseed = TRANSFER( ziseed , zrseed) 
     779            idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     780            WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg     ! "(ix.x)" 
    773781            DO jseed = 1 , 4 
    774                WRITE(clseed(5:5) ,'(i1.1)') jseed 
    775                WRITE(clseed(7:10),'(i4.4)') narea 
    776                CALL iom_rstput( kt, nitrst, numstow, clseed , zrseed(jseed) ) 
     782               WRITE(clseed(5:5)      ,'(i1.1)') jseed 
     783               WRITE(clseed(7:7+idg-1),  clfmt ) narea 
     784               CALL iom_rstput( kt, nitrst, numstow, clseed(1:7+idg-1), zrseed(jseed) ) 
    777785            END DO 
    778786            ! 2D stochastic parameters 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdtra.F90

    r12724 r13193  
    8383      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8484      ! 
    85       INTEGER ::   jk   ! loop indices 
     85      INTEGER ::   jk    ! loop indices 
     86      INTEGER ::   i01   ! 0 or 1 
    8687      REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
    8788      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
    … …  
    9192         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
    9293      ENDIF 
    93  
     94      ! 
     95      i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 
     96      ! 
    9497      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
    9598         ! 
    96          SELECT CASE( ktrd ) 
     99         SELECT CASE( ktrd*i01 ) 
    97100         !                            ! advection: transform the advective flux into a trend 
    98101         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
    … …  
    113116      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
    114117         ! 
    115          SELECT CASE( ktrd ) 
     118         SELECT CASE( ktrd*i01 ) 
    116119         !                            ! advection: transform the advective flux into a trend 
    117120         !                            !            and send T & S trends to trd_tra_mng 
    … …  
    168171      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
    169172         ! 
    170          SELECT CASE( ktrd ) 
     173         SELECT CASE( ktrd*i01 ) 
    171174         !                            ! advection: transform the advective flux into a masked trend 
    172175         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/USR/usrdef_zgr.F90

    r12377 r13193  
    202202      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    203203      ! 
    204       k_bot(:,:) = NINT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     204      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 
    205205      ! 
    206206      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdftke.F90

    r12724 r13193  
    4545   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    4646   USE zdfmxl         ! vertical physics: mixed layer 
     47#if defined key_si3 
     48   USE ice, ONLY: hm_i, h_i 
     49#endif 
     50#if defined key_cice 
     51   USE sbc_ice, ONLY: h_i 
     52#endif 
    4753   ! 
    4854   USE in_out_manager ! I/O manager 
    … …  
    6470   INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
    6571   REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
     72   INTEGER  ::      nn_mxlice ! type of scaling under sea-ice 
     73   REAL(wp) ::      rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    6674   INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
    6775   REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
    … …  
    245253               zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
    246254                  &                                           + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
    247                en(ji,jj,mikt(ji,jj)) = en(ji,jj,1) * tmask(ji,jj,1) + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj)   ! masked at ocean surface 
     255               ! (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) = 1 where ice shelves are present 
     256               en(ji,jj,mikt(ji,jj)) = en(ji,jj,1)           * tmask(ji,jj,1) & 
     257                  &                  + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 
    248258            END_2D 
    249259         ENDIF 
    … …  
    424434      REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars 
    425435      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    426       REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
     436      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    427437      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
    428438      !!-------------------------------------------------------------------- 
    … …  
    438448      zmxld(:,:,:)  = rmxl_min 
    439449      ! 
    440       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     450     IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     451         ! 
    441452         zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
     453#if ! defined key_si3 && ! defined key_cice 
    442454         DO_2D_00_00 
    443             zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
     455            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    444456         END_2D 
    445       ELSE  
     457#else 
     458         SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     459         ! 
     460         CASE( 0 )                      ! No scaling under sea-ice 
     461            DO_2D_00_00 
     462               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     463            END_2D 
     464            ! 
     465         CASE( 1 )                           ! scaling with constant sea-ice thickness 
     466            DO_2D_00_00 
     467               zmxlm(ji,jj,1) =  ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 
     468            END_2D 
     469            ! 
     470         CASE( 2 )                                 ! scaling with mean sea-ice thickness 
     471            DO_2D_00_00 
     472#if defined key_si3 
     473               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 
     474#elif defined key_cice 
     475               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     476               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     477#endif 
     478            END_2D 
     479            ! 
     480         CASE( 3 )                                 ! scaling with max sea-ice thickness 
     481            DO_2D_00_00 
     482               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     483               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     484            END_2D 
     485            ! 
     486         END SELECT 
     487#endif 
     488         ! 
     489         DO_2D_00_00 
     490            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
     491         END_2D 
     492         ! 
     493      ELSE 
    446494         zmxlm(:,:,1) = rn_mxl0 
    447495      ENDIF 
     496 
    448497      ! 
    449498      DO_3D_00_00( 2, jpkm1 ) 
    … …  
    554603      INTEGER             ::   ios 
    555604      !! 
    556       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          & 
    557          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,          & 
    558          &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc,   & 
    559          &                 nn_etau , nn_htau  , rn_efr , rn_eice   
     605      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,  & 
     606         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,  & 
     607         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
     608         &                 nn_pdl  , ln_drg   , ln_lc    , rn_lc,      & 
     609         &                 nn_etau , nn_htau  , rn_efr   , rn_eice   
    560610      !!---------------------------------------------------------------------- 
    561611      ! 
    … …  
    583633         WRITE(numout,*) '      mixing length type                          nn_mxl    = ', nn_mxl 
    584634         WRITE(numout,*) '         surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0 
     635         IF( ln_mxl0 ) THEN 
     636            WRITE(numout,*) '      type of scaling under sea-ice               nn_mxlice = ', nn_mxlice 
     637            IF( nn_mxlice == 1 ) & 
     638            WRITE(numout,*) '      ice thickness when scaling under sea-ice    rn_mxlice = ', rn_mxlice 
     639         ENDIF          
    585640         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0 
    586641         WRITE(numout,*) '      top/bottom friction forcing flag            ln_drg    = ', ln_drg 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/nemogcm.F90

    r12732 r13193  
    194194      END DO 
    195195      ! 
    196       IF( .NOT. Agrif_Root() ) THEN 
    197          CALL Agrif_ParentGrid_To_ChildGrid() 
    198          IF( ln_diaobs )   CALL dia_obs_wri 
    199          IF( ln_timing )   CALL timing_finalize 
    200          CALL Agrif_ChildGrid_To_ParentGrid() 
    201       ENDIF 
    202       ! 
    203196# else 
    204197      ! 
    … …  
    249242      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    250243         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    251          CALL ctl_stop( ctmp1 ) 
     244         IF( ngrdstop > 0 ) THEN 
     245            WRITE(ctmp9,'(i2)') ngrdstop 
     246            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     247            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     248            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     249         ELSE 
     250            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     251            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     252         ENDIF 
    252253      ENDIF 
    253254      ! 
    … …  
    261262#else 
    262263      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    263       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
     264      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications 
    264265      ENDIF 
    265266#endif 
    … …  
    347348      ! 
    348349      ! finalize the definition of namctl variables 
    349       IF( sn_cfctl%l_allon ) THEN 
    350          ! Turn on all options. 
    351          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    352          ! Ensure all processors are active 
    353          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    354       ELSEIF( sn_cfctl%l_config ) THEN 
    355          ! Activate finer control of report outputs 
    356          ! optionally switch off output from selected areas (note this only 
    357          ! applies to output which does not involve global communications) 
    358          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    359            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    360            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    361       ELSE 
    362          ! turn off all options. 
    363          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    364       ENDIF 
     350      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     351         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    365352      ! 
    366353      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    546533         WRITE(numout,*) '~~~~~~~~' 
    547534         WRITE(numout,*) '   Namelist namctl' 
    548          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    549          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    550          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    551535         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    552536         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    696680 
    697681 
    698    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     682   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    699683      !!---------------------------------------------------------------------- 
    700684      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    701685      !! 
    702686      !! ** Purpose :   Set elements of the output control structure to setto. 
    703       !!                for_all should be .false. unless all areas are to be 
    704       !!                treated identically. 
    705687      !! 
    706688      !! ** Method  :   Note this routine can be used to switch on/off some 
    707       !!                types of output for selected areas but any output types 
    708       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    709       !!                should be protected from selective switching by the 
    710       !!                for_all argument 
    711       !!---------------------------------------------------------------------- 
    712       LOGICAL :: setto, for_all 
    713       TYPE(sn_ctl) :: sn_cfctl 
    714       !!---------------------------------------------------------------------- 
    715       IF( for_all ) THEN 
    716          sn_cfctl%l_runstat = setto 
    717          sn_cfctl%l_trcstat = setto 
    718       ENDIF 
     689      !!                types of output for selected areas. 
     690      !!---------------------------------------------------------------------- 
     691      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     692      LOGICAL     , INTENT(in   ) :: setto 
     693      !!---------------------------------------------------------------------- 
     694      sn_cfctl%l_runstat = setto 
     695      sn_cfctl%l_trcstat = setto 
    719696      sn_cfctl%l_oceout  = setto 
    720697      sn_cfctl%l_layout  = setto 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/step.F90

    r12724 r13193  
    8686      !!---------------------------------------------------------------------- 
    8787      INTEGER ::   ji, jj, jk   ! dummy loop indice 
    88       INTEGER ::   indic        ! error indicator if < 0 
    8988!!gm kcall can be removed, I guess 
    9089      INTEGER ::   kcall        ! optional integer argument (dom_vvl_sf_nxt) 
    9190      !! --------------------------------------------------------------------- 
    9291#if defined key_agrif 
    93       IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step  
     92      IF( nstop > 0 ) RETURN   ! avoid to go further if an error was detected during previous time step (child grid) 
    9493      kstp = nit000 + Agrif_Nb_Step() 
    9594      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    … …  
    119118      ! update I/O and calendar  
    120119      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    121                              indic = 0                ! reset to no error condition 
    122                               
    123120      IF( kstp == nit000 ) THEN                       ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    124                              CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including passible AGRIF zoom) 
     121                             CALL iom_init( cxios_context, ld_closedef=.FALSE. )   ! for model grid (including possible AGRIF zoom) 
    125122         IF( lk_diamlr   )   CALL dia_mlr_iom_init    ! with additional setup for multiple-linear-regression analysis 
    126123                             CALL iom_init_closedef 
    … …  
    318315                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices 
    319316                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
     317 
    320318#endif 
    321319      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    322320      ! Control 
    323321      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    324                          CALL stp_ctl      ( kstp, Nbb, Nnn, indic ) 
     322                         CALL stp_ctl      ( kstp, Nnn ) 
     323 
    325324#if defined key_agrif 
    326325      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    330329                         CALL Agrif_update_all( )                  ! Update all components 
    331330      ENDIF 
    332 #endif 
    333       IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     331 
     332#endif 
     333      IF( ln_diaobs .AND. nstop == 0 )  CALL dia_obs( kstp, Nnn )  ! obs-minus-model (assimilation) diags (after dynamics update) 
    334334 
    335335      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    345345      ! Coupled mode 
    346346      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    347 !!gm why lk_oasis and not lk_cpl ???? 
    348       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges 
     347      IF( lk_oasis .AND. nstop == 0 )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges 
    349348      ! 
    350349#if defined key_iomput 
    … …  
    352351      ! Finalize contextes if end of simulation or error detected 
    353352      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
    354       IF( kstp == nitend .OR. indic < 0 ) THEN  
     353      IF( kstp == nitend .OR. nstop > 0 ) THEN  
    355354                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
    356355         IF( lrxios ) CALL iom_context_finalize(      crxios_context         ) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stpctl.F90

    r12377 r13193  
    1919   USE dom_oce         ! ocean space and time domain variables  
    2020   USE c1d             ! 1D vertical configuration 
     21   USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
     22   USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
     23   !   
    2124   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    22    ! 
    2325   USE in_out_manager  ! I/O manager 
    2426   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2527   USE lib_mpp         ! distributed memory computing 
    26    USE zdf_oce ,  ONLY : ln_zad_Aimp       ! ocean vertical physics variables 
    27    USE wet_dry,   ONLY : ll_wd, ssh_ref    ! reference depth for negative bathy 
    28  
     28   ! 
    2929   USE netcdf          ! NetCDF library 
    3030   IMPLICIT NONE 
    … …  
    3333   PUBLIC stp_ctl           ! routine called by step.F90 
    3434 
    35    INTEGER  ::   idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus 
    36    LOGICAL  ::   lsomeoce 
     35   INTEGER                ::   nrunid   ! netcdf file id 
     36   INTEGER, DIMENSION(8)  ::   nvarid   ! netcdf variable id 
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4242CONTAINS 
    4343 
    44    SUBROUTINE stp_ctl( kt, Kbb, Kmm, kindic ) 
     44   SUBROUTINE stp_ctl( kt, Kmm ) 
    4545      !!---------------------------------------------------------------------- 
    4646      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    5050      !! ** Method  : - Save the time step in numstp 
    5151      !!              - Print it each 50 time steps 
    52       !!              - Stop the run IF problem encountered by setting indic=-3 
     52      !!              - Stop the run IF problem encountered by setting nstop > 0 
    5353      !!                Problems checked: |ssh| maximum larger than 10 m 
    5454      !!                                  |U|   maximum larger than 10 m/s  
    … …  
    5757      !! ** Actions :   "time.step" file = last ocean time-step 
    5858      !!                "run.stat"  file = run statistics 
    59       !!                nstop indicator sheared among all local domain (lk_mpp=T) 
     59      !!                 nstop indicator sheared among all local domain 
    6060      !!---------------------------------------------------------------------- 
    6161      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    62       INTEGER, INTENT(in   ) ::   Kbb, Kmm      ! ocean time level index 
    63       INTEGER, INTENT(inout) ::   kindic   ! error indicator 
    64       !! 
    65       INTEGER                ::   ji, jj, jk          ! dummy loop indices 
    66       INTEGER, DIMENSION(2)  ::   ih                  ! min/max loc indices 
    67       INTEGER, DIMENSION(3)  ::   iu, is1, is2        ! min/max loc indices 
    68       REAL(wp)               ::   zzz                 ! local real  
    69       REAL(wp), DIMENSION(9) ::   zmax 
    70       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    71       CHARACTER(len=20) :: clname 
    72       !!---------------------------------------------------------------------- 
    73       ! 
    74       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    75       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    76       ll_wrtruns = ll_colruns .AND. lwm 
    77       IF( kt == nit000 .AND. lwp ) THEN 
    78          WRITE(numout,*) 
    79          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    80          WRITE(numout,*) '~~~~~~~' 
    81          !                                ! open time.step file 
    82          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    83          !                                ! open run.stat file(s) at start whatever 
    84          !                                ! the value of sn_cfctl%ptimincr 
    85          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     62      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     63      !! 
     64      INTEGER                         ::   ji                                    ! dummy loop indices 
     65      INTEGER                         ::   idtime, istatus 
     66      INTEGER , DIMENSION(9)          ::   iareasum, iareamin, iareamax 
     67      INTEGER , DIMENSION(3,4)        ::   iloc                                  ! min/max loc indices 
     68      REAL(wp)                        ::   zzz                                   ! local real  
     69      REAL(wp), DIMENSION(9)          ::   zmax, zmaxlocal 
     70      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     71      LOGICAL, DIMENSION(jpi,jpj,jpk) ::   llmsk 
     72      CHARACTER(len=20)               ::   clname 
     73      !!---------------------------------------------------------------------- 
     74      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     75      ! 
     76      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     77      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     78      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     79      ! 
     80      IF( kt == nit000 ) THEN 
     81         ! 
     82         IF( lwp ) THEN 
     83            WRITE(numout,*) 
     84            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     85            WRITE(numout,*) '~~~~~~~' 
     86         ENDIF 
     87         !                                ! open time.step    ascii file, done only by 1st subdomain 
     88         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     89         ! 
     90         IF( ll_wrtruns ) THEN 
     91            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    8692            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     93            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    8794            clname = 'run.stat.nc' 
    8895            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    89             istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 
    90             istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 
    91             istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 
    92             istatus = NF90_DEF_VAR( idrun,   'abs_u_max', NF90_DOUBLE, (/ idtime /), idu  ) 
    93             istatus = NF90_DEF_VAR( idrun,       's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 
    94             istatus = NF90_DEF_VAR( idrun,       's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 
    95             istatus = NF90_DEF_VAR( idrun,       't_min', NF90_DOUBLE, (/ idtime /), idt1 ) 
    96             istatus = NF90_DEF_VAR( idrun,       't_max', NF90_DOUBLE, (/ idtime /), idt2 ) 
     96            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     97            istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     99            istatus = NF90_DEF_VAR( nrunid,   'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     100            istatus = NF90_DEF_VAR( nrunid,       's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     101            istatus = NF90_DEF_VAR( nrunid,       's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 
     102            istatus = NF90_DEF_VAR( nrunid,       't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 
     103            istatus = NF90_DEF_VAR( nrunid,       't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 
    97104            IF( ln_zad_Aimp ) THEN 
    98                istatus = NF90_DEF_VAR( idrun,   'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1 ) 
    99                istatus = NF90_DEF_VAR( idrun,       'Cf_max', NF90_DOUBLE, (/ idtime /), idc1 ) 
     105               istatus = NF90_DEF_VAR( nrunid,   'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 
     106               istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 
    100107            ENDIF 
    101             istatus = NF90_ENDDEF(idrun) 
    102             zmax(8:9) = 0._wp    ! initialise to zero in case ln_zad_Aimp option is not in use 
    103          ENDIF 
    104       ENDIF 
    105       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    106       ! 
    107       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     108            istatus = NF90_ENDDEF(nrunid) 
     109         ENDIF 
     110         !     
     111      ENDIF 
     112      ! 
     113      !                                   !==              write current time step              ==! 
     114      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     115      IF( lwm .AND. ll_wrtstp ) THEN 
    108116         WRITE ( numstp, '(1x, i8)' )   kt 
    109117         REWIND( numstp ) 
    110118      ENDIF 
    111       ! 
    112       !                                   !==  test of extrema  ==! 
    113       IF( ll_wd ) THEN 
    114          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) )  )        ! ssh max  
    115       ELSE 
    116          zmax(1) = MAXVAL(  ABS( ssh(:,:,Kmm) )  )                               ! ssh max 
    117       ENDIF 
    118       zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) )  )                                  ! velocity max (zonal only) 
    119       zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus salinity max 
    120       zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       salinity max 
    121       zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   ! minus temperature max 
    122       zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp )   !       temperature max 
    123       zmax(7) = REAL( nstop , wp )                                            ! stop indicator 
    124       IF( ln_zad_Aimp ) THEN 
    125          zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 
    126          zmax(9) = MAXVAL(   Cu_adv(:,:,:)   , mask = tmask(:,:,:) == 1._wp ) ! partitioning coeff. max 
    127       ENDIF 
    128       ! 
     119      !                                   !==            test of local extrema           ==! 
     120      !                                   !==  done by all processes at every time step  ==! 
     121      ! 
     122      ! define zmax default value. needed for land processors 
     123      IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     124         zmax(:) = -HUGE(1._wp) 
     125      ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     126         zmax(:) =  0._wp 
     127         zmax(3) = -1._wp      ! avoid salinity minimum at 0. 
     128      ENDIF 
     129      ! 
     130      llmsk(:,:,1) = ssmask(:,:) == 1._wp 
     131      IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     132         IF( ll_wd ) THEN 
     133            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     134         ELSE 
     135            zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     136         ENDIF 
     137      ENDIF 
     138      zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only) 
     139      llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     140      IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     141         zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     142         zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     143         IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     144            zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     145            zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     146            IF( ln_zad_Aimp ) THEN 
     147               zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     148               llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     149               IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     150                  zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max 
     151               ENDIF 
     152            ENDIF 
     153         ENDIF 
     154      ENDIF 
     155      zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
     156      !                                   !==               get global extrema             ==! 
     157      !                                   !==  done by all processes if writting run.stat  ==! 
    129158      IF( ll_colruns ) THEN 
     159         zmaxlocal(:) = zmax(:) 
    130160         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
    131          nstop = NINT( zmax(7) )                 ! nstop indicator sheared among all local domains 
    132       ENDIF 
    133       !                                   !==  run statistics  ==!   ("run.stat" files) 
     161         nstop = NINT( zmax(9) )                 ! update nstop indicator (now sheared among all local domains) 
     162      ENDIF 
     163      !                                   !==              write "run.stat" files              ==! 
     164      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
    134165      IF( ll_wrtruns ) THEN 
    135166         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 
    136          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    137          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    138          istatus = NF90_PUT_VAR( idrun,  ids1, (/-zmax(3)/), (/kt/), (/1/) ) 
    139          istatus = NF90_PUT_VAR( idrun,  ids2, (/ zmax(4)/), (/kt/), (/1/) ) 
    140          istatus = NF90_PUT_VAR( idrun,  idt1, (/-zmax(5)/), (/kt/), (/1/) ) 
    141          istatus = NF90_PUT_VAR( idrun,  idt2, (/ zmax(6)/), (/kt/), (/1/) ) 
     167         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     168         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     169         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     170         istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 
     171         istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 
     172         istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 
    142173         IF( ln_zad_Aimp ) THEN 
    143             istatus = NF90_PUT_VAR( idrun,  idw1, (/ zmax(8)/), (/kt/), (/1/) ) 
    144             istatus = NF90_PUT_VAR( idrun,  idc1, (/ zmax(9)/), (/kt/), (/1/) ) 
    145          ENDIF 
    146          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    147          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
     174            istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 
     175            istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 
     176         ENDIF 
     177         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    148178      END IF 
    149       !                                   !==  error handling  ==! 
    150       IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. (   &  ! domain contains some ocean points, check for sensible ranges 
    151          &  zmax(1) >   20._wp .OR.   &                    ! too large sea surface height ( > 20 m ) 
    152          &  zmax(2) >   10._wp .OR.   &                    ! too large velocity ( > 10 m/s) 
    153          &  zmax(3) >=   0._wp .OR.   &                    ! negative or zero sea surface salinity 
    154          &  zmax(4) >= 100._wp .OR.   &                    ! too large sea surface salinity ( > 100 ) 
    155          &  zmax(4) <    0._wp .OR.   &                    ! too large sea surface salinity (keep this line for sea-ice) 
    156          &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN   ! NaN encounter in the tests 
    157          IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN 
    158             ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed) 
    159             CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm))        , ssmask(:,:)  , zzz, ih  ) 
    160             CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm))          , umask (:,:,:), zzz, iu  ) 
    161             CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 
    162             CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 
     179      !                                   !==               error handling               ==! 
     180      !                                   !==  done by all processes at every time step  ==! 
     181      ! 
     182      IF(   zmax(1) >   20._wp .OR.   &                   ! too large sea surface height ( > 20 m ) 
     183         &  zmax(2) >   10._wp .OR.   &                   ! too large velocity ( > 10 m/s) 
     184         &  zmax(3) >=   0._wp .OR.   &                   ! negative or zero sea surface salinity 
     185         &  zmax(4) >= 100._wp .OR.   &                   ! too large sea surface salinity ( > 100 ) 
     186         &  zmax(4) <    0._wp .OR.   &                   ! too large sea surface salinity (keep this line for sea-ice) 
     187         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     188         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     189         ! 
     190         iloc(:,:) = 0 
     191         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     192            ! first: close the netcdf file, so we can read it 
     193            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     194            ! get global loc on the min/max 
     195            CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,         Kmm)), ssmask(:,:  ), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     196            CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,       Kmm)),  umask(:,:,:), zzz, iloc(1:3,2) ) 
     197            CALL mpp_minloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,3) ) 
     198            CALL mpp_maxloc( 'stpctl',      ts(:,:,:,jp_sal,Kmm) ,  tmask(:,:,:), zzz, iloc(1:3,4) ) 
     199            ! find which subdomain has the max. 
     200            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     201            DO ji = 1, 9 
     202               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     203                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     204               ENDIF 
     205            END DO 
     206            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     207            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     208            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     209         ELSE                    ! find local min and max locations: 
     210            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     211            iloc(1:2,1) = MAXLOC( ABS( ssh(:,:,         Kmm)), mask = ssmask(:,:  ) == 1._wp ) + (/ nimpp - 1, njmpp - 1    /) 
     212            iloc(1:3,2) = MAXLOC( ABS(  uu(:,:,:,       Kmm)), mask =  umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     213            iloc(1:3,3) = MINLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     214            iloc(1:3,4) = MAXLOC(       ts(:,:,:,jp_sal,Kmm) , mask =  tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
     215            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     216         ENDIF 
     217         ! 
     218         WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
     219         CALL wrt_line( ctmp2, kt, '|ssh| max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     220         CALL wrt_line( ctmp3, kt, '|U|   max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     221         CALL wrt_line( ctmp4, kt, 'Sal   min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     222         CALL wrt_line( ctmp5, kt, 'Sal   max',  zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 
     223         IF( Agrif_Root() ) THEN 
     224            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
    163225         ELSE 
    164             ! find local min and max locations 
    165             ih(:)  = MAXLOC( ABS( ssh(:,:,Kmm)   )                              ) + (/ nimpp - 1, njmpp - 1    /) 
    166             iu(:)  = MAXLOC( ABS( uu  (:,:,:,Kmm) )                              ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    167             is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    168             is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 
    169          ENDIF 
    170           
    171          WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m  or  |U| > 10 m/s  or  S <= 0  or  S >= 100  or  NaN encounter in the tests' 
    172          WRITE(ctmp2,9100) kt,   zmax(1), ih(1) , ih(2) 
    173          WRITE(ctmp3,9200) kt,   zmax(2), iu(1) , iu(2) , iu(3) 
    174          WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 
    175          WRITE(ctmp5,9400) kt,   zmax(4), is2(1), is2(2), is2(3) 
    176          WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort.nc file' 
    177           
     226            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     227         ENDIF 
     228         ! 
    178229         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
    179           
    180          IF( .NOT. sn_cfctl%l_glochk ) THEN 
    181             WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 
    182             CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6 ) 
    183          ELSE 
    184             CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' ) 
    185          ENDIF 
    186  
    187          kindic = -3 
    188          ! 
    189       ENDIF 
    190       ! 
    191 9100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
    192 9200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
    193 9300  FORMAT (' kt=',i8,'   S     min: ',1pg11.4,', at  i j k: ',3i5) 
    194 9400  FORMAT (' kt=',i8,'   S     max: ',1pg11.4,', at  i j k: ',3i5) 
     230         ! 
     231         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     232            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     233            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     234            ENDIF 
     235         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     236            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     237         ENDIF 
     238         ! 
     239      ENDIF 
     240      ! 
     241      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     242         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     243         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     244      ENDIF 
     245      ! 
    1952469500  FORMAT(' it :', i8, '    |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 
    196247      ! 
    197248   END SUBROUTINE stp_ctl 
     249 
     250 
     251   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     252      !!---------------------------------------------------------------------- 
     253      !!                     ***  ROUTINE wrt_line  *** 
     254      !! 
     255      !! ** Purpose :   write information line 
     256      !! 
     257      !!---------------------------------------------------------------------- 
     258      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     259      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     260      REAL(wp),              INTENT(in   ) ::   pval 
     261      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     262      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     263      ! 
     264      CHARACTER(len=80) ::   clsuff 
     265      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     266      CHARACTER(len=9 ) ::   cli, clj, clk 
     267      CHARACTER(len=1 ) ::   clfmt 
     268      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     269      INTEGER           ::   ifmtk 
     270      !!---------------------------------------------------------------------- 
     271      WRITE(clkt , '(i9)') kt 
     272       
     273      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     274      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     275      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     276      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     277      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     278                                   WRITE(clmax, cl4) kmax-1 
     279      ! 
     280      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     281      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     282      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     283      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     284      ! 
     285      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     286      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     287      ENDIF 
     288      IF(kloc(3) == 0) THEN 
     289         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     290         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     291         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     292      ELSE 
     293         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     294         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     295         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     296         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     297      ENDIF 
     298      ! 
     2999100  FORMAT('MPI rank ', a) 
     3009200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     3019300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     3029400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     303      ! 
     304   END SUBROUTINE wrt_line 
     305 
    198306 
    199307   !!====================================================================== 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OFF/nemogcm.F90

    r12779 r13193  
    3131   USE domqco         ! tools for scale factor         (dom_qco_r3c  routine) 
    3232#endif 
     33   USE bdy_oce,  ONLY : ln_bdy 
     34   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    3335   !              ! ocean physics 
    3436   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) 
    … …  
    9395      !!              Madec, 2008, internal report, IPSL. 
    9496      !!---------------------------------------------------------------------- 
    95       INTEGER :: istp, indic       ! time step index 
     97      INTEGER :: istp       ! time step index 
    9698      !!---------------------------------------------------------------------- 
    9799 
    … …  
    145147# endif 
    146148#endif          
    147                                 CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
     149                                CALL stp_ctl    ( istp )             ! Time loop: control and print 
    148150         istp = istp + 1 
    149151      END DO 
    … …  
    160162      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
    161163         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    162          CALL ctl_stop( ctmp1 ) 
     164         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     165         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    163166      ENDIF 
    164167      ! 
    … …  
    242245      ! 
    243246      ! finalize the definition of namctl variables 
    244       IF( sn_cfctl%l_allon ) THEN 
    245          ! Turn on all options. 
    246          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    247          ! Ensure all processors are active 
    248          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    249       ELSEIF( sn_cfctl%l_config ) THEN 
    250          ! Activate finer control of report outputs 
    251          ! optionally switch off output from selected areas (note this only 
    252          ! applies to output which does not involve global communications) 
    253          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    254            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    255            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    256       ELSE 
    257          ! turn off all options. 
    258          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    259       ENDIF 
     247      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     248         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    260249      ! 
    261250      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    322311      ! Initialise time level indices 
    323312      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    324     
    325313 
    326314      !                             !-------------------------------! 
    … …  
    344332 
    345333                           CALL     sbc_init( Nbb, Nnn, Naa )    ! Forcings : surface module 
     334                           CALL     bdy_init    ! Open boundaries initialisation     
    346335 
    347336      !                                      ! Tracer physics 
    … …  
    386375         WRITE(numout,*) '~~~~~~~~' 
    387376         WRITE(numout,*) '   Namelist namctl' 
    388          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    389          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    390          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    391377         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    392378         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    507493      USE zdf_oce,   ONLY : zdf_oce_alloc 
    508494      USE trc_oce,   ONLY : trc_oce_alloc 
     495      USE bdy_oce,   ONLY : bdy_oce_alloc 
    509496      ! 
    510497      INTEGER :: ierr 
    … …  
    516503      ierr = ierr + zdf_oce_alloc()          ! ocean vertical physics 
    517504      ierr = ierr + trc_oce_alloc()          ! shared TRC / TRA arrays 
     505      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)       
    518506      ! 
    519507      CALL mpp_sum( 'nemogcm', ierr ) 
    … …  
    522510   END SUBROUTINE nemo_alloc 
    523511 
    524    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     512   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    525513      !!---------------------------------------------------------------------- 
    526514      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    527515      !! 
    528516      !! ** Purpose :   Set elements of the output control structure to setto. 
    529       !!                for_all should be .false. unless all areas are to be 
    530       !!                treated identically. 
    531       !! 
     517     !! 
    532518      !! ** Method  :   Note this routine can be used to switch on/off some 
    533       !!                types of output for selected areas but any output types 
    534       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    535       !!                should be protected from selective switching by the 
    536       !!                for_all argument 
    537       !!---------------------------------------------------------------------- 
    538       LOGICAL :: setto, for_all 
    539       TYPE(sn_ctl) :: sn_cfctl 
    540       !!---------------------------------------------------------------------- 
    541       IF( for_all ) THEN 
    542          sn_cfctl%l_runstat = setto 
    543          sn_cfctl%l_trcstat = setto 
    544       ENDIF 
     519      !!                types of output for selected areas. 
     520      !!---------------------------------------------------------------------- 
     521      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     522      LOGICAL     , INTENT(in   ) :: setto 
     523      !!---------------------------------------------------------------------- 
     524      sn_cfctl%l_runstat = setto 
     525      sn_cfctl%l_trcstat = setto 
    545526      sn_cfctl%l_oceout  = setto 
    546527      sn_cfctl%l_layout  = setto 
    … …  
    572553 
    573554 
    574    SUBROUTINE stp_ctl( kt, kindic ) 
     555   SUBROUTINE stp_ctl( kt ) 
    575556      !!---------------------------------------------------------------------- 
    576557      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    583564      !!---------------------------------------------------------------------- 
    584565      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
    585       INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
    586566      !!---------------------------------------------------------------------- 
    587567      ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAO/nemogcm.F90

    r12724 r13193  
    158158      ! 
    159159      ! finalize the definition of namctl variables 
    160       IF( sn_cfctl%l_allon ) THEN 
    161          ! Turn on all options. 
    162          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    163          ! Ensure all processors are active 
    164          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    165       ELSEIF( sn_cfctl%l_config ) THEN 
    166          ! Activate finer control of report outputs 
    167          ! optionally switch off output from selected areas (note this only 
    168          ! applies to output which does not involve global communications) 
    169          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    170            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    171            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    172       ELSE 
    173          ! turn off all options. 
    174          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    175       ENDIF 
     160      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     161         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    176162      ! 
    177163      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    270256         WRITE(numout,*) '~~~~~~~~' 
    271257         WRITE(numout,*) '   Namelist namctl' 
    272          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    273          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    274          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    275258         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    276259         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    410393   END SUBROUTINE nemo_alloc 
    411394 
    412    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     395   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    413396      !!---------------------------------------------------------------------- 
    414397      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    415398      !! 
    416399      !! ** Purpose :   Set elements of the output control structure to setto. 
    417       !!                for_all should be .false. unless all areas are to be 
    418       !!                treated identically. 
    419400      !! 
    420401      !! ** Method  :   Note this routine can be used to switch on/off some 
    421       !!                types of output for selected areas but any output types 
    422       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    423       !!                should be protected from selective switching by the 
    424       !!                for_all argument 
    425       !!---------------------------------------------------------------------- 
    426       LOGICAL :: setto, for_all 
    427       TYPE(sn_ctl) :: sn_cfctl 
    428       !!---------------------------------------------------------------------- 
    429       IF( for_all ) THEN 
    430          sn_cfctl%l_runstat = setto 
    431          sn_cfctl%l_trcstat = setto 
    432       ENDIF 
     402      !!                types of output for selected areas. 
     403      !!---------------------------------------------------------------------- 
     404      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     405      LOGICAL     , INTENT(in   ) :: setto 
     406      !!---------------------------------------------------------------------- 
     407      sn_cfctl%l_runstat = setto 
     408      sn_cfctl%l_trcstat = setto 
    433409      sn_cfctl%l_oceout  = setto 
    434410      sn_cfctl%l_layout  = setto 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAS/diawri.F90

    r12724 r13193  
    138138      !!      Each nn_write time step, output the instantaneous or mean fields 
    139139      !!---------------------------------------------------------------------- 
    140       !! 
    141140      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    142       INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
     141      INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index 
    143142      !! 
    144143      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    … …  
    462461         CALL iom_close( inum ) 
    463462      ENDIF 
    464 #endif 
    465  
     463      ! 
     464#endif 
    466465   END SUBROUTINE dia_wri_state 
    467466 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAS/nemogcm.F90

    r12724 r13193  
    126126      END DO 
    127127      ! 
    128       IF( .NOT. Agrif_Root() ) THEN 
    129          CALL Agrif_ParentGrid_To_ChildGrid() 
    130          IF( ln_timing )   CALL timing_finalize 
    131          CALL Agrif_ChildGrid_To_ParentGrid() 
    132       ENDIF 
    133       ! 
    134128#else 
    135129      ! 
    … …  
    166160      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    167161         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    168          CALL ctl_stop( ctmp1 ) 
     162         IF( ngrdstop > 0 ) THEN 
     163            WRITE(ctmp9,'(i2)') ngrdstop 
     164            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     165            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     166            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     167         ELSE 
     168            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     169            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     170         ENDIF 
    169171      ENDIF 
    170172      ! 
    … …  
    275277      ! 
    276278      ! finalize the definition of namctl variables 
    277       IF( sn_cfctl%l_allon ) THEN 
    278          ! Turn on all options. 
    279          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    280          ! Ensure all processors are active 
    281          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    282       ELSEIF( sn_cfctl%l_config ) THEN 
    283          ! Activate finer control of report outputs 
    284          ! optionally switch off output from selected areas (note this only 
    285          ! applies to output which does not involve global communications) 
    286          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    287            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    288            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    289       ELSE 
    290          ! turn off all options. 
    291          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    292       ENDIF 
     279      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     280         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    293281      ! 
    294282      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    408396         WRITE(numout,*) '~~~~~~~~' 
    409397         WRITE(numout,*) '   Namelist namctl' 
    410          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    411          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    412          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    413398         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    414399         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    552537   END SUBROUTINE nemo_alloc 
    553538 
    554    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     539   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    555540      !!---------------------------------------------------------------------- 
    556541      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    557542      !! 
    558543      !! ** Purpose :   Set elements of the output control structure to setto. 
    559       !!                for_all should be .false. unless all areas are to be 
    560       !!                treated identically. 
    561544      !! 
    562545      !! ** Method  :   Note this routine can be used to switch on/off some 
    563       !!                types of output for selected areas but any output types 
    564       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    565       !!                should be protected from selective switching by the 
    566       !!                for_all argument 
    567       !!---------------------------------------------------------------------- 
    568       LOGICAL :: setto, for_all 
    569       TYPE(sn_ctl) :: sn_cfctl 
    570       !!---------------------------------------------------------------------- 
    571       IF( for_all ) THEN 
    572          sn_cfctl%l_runstat = setto 
    573          sn_cfctl%l_trcstat = setto 
    574       ENDIF 
     546      !!                types of output for selected areas. 
     547      !!---------------------------------------------------------------------- 
     548      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     549      LOGICAL     , INTENT(in   ) :: setto 
     550      !!---------------------------------------------------------------------- 
     551      sn_cfctl%l_runstat = setto 
     552      sn_cfctl%l_trcstat = setto 
    575553      sn_cfctl%l_oceout  = setto 
    576554      sn_cfctl%l_layout  = setto 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAS/step.F90

    r12724 r13193  
    7474      !!              -2- Outputs and diagnostics 
    7575      !!---------------------------------------------------------------------- 
    76       INTEGER ::   indic    ! error indicator if < 0 
    77       !! --------------------------------------------------------------------- 
    7876 
    7977#if defined key_agrif 
    80       IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step  
     78      IF( nstop > 0 ) RETURN   ! avoid to go further if an error was detected during previous time step (child grid) 
    8179      kstp = nit000 + Agrif_Nb_Step() 
    8280      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    83       IF ( lk_agrif_debug ) THEN 
    84          IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    85          IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
     81      IF( lk_agrif_debug ) THEN 
     82         IF( Agrif_Root() .and. lwp)   WRITE(*,*) '---' 
     83         IF(lwp)   WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 
    8684      ENDIF 
    87  
    88       IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    89  
     85      IF( kstp == nit000 + 1 )   lk_agrif_fstep = .FALSE. 
    9086# if defined key_iomput 
    9187      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    9288# endif    
    9389#endif    
    94                              indic = 0                    ! although indic is not changed in stp_ctl 
    95                                                           ! need to keep the same interface  
    9690      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9791      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
    … …  
    112106      ! AGRIF recursive integration 
    113107      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    114                              CALL Agrif_Integrate_ChildGrids( stp )   
    115 #endif 
     108                             CALL Agrif_Integrate_ChildGrids( stp ) 
    116109                              
     110#endif                              
    117111      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    118112      ! Control 
    119113      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    120                              CALL stp_ctl( kstp, indic ) 
    121       IF( indic < 0  )  THEN 
    122                              CALL ctl_stop( 'step: indic < 0' ) 
    123                              CALL dia_wri_state( Nnn, 'output.abort' ) 
    124       ENDIF 
     114                             CALL stp_ctl( kstp, Nnn ) 
     115 
    125116#if defined key_agrif 
    126117      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    132123#endif 
    133124      ENDIF 
     125 
    134126#endif 
    135127      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    141133      ! Coupled mode 
    142134      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    143       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
     135      IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn )       ! coupled mode : field exchanges if OASIS-coupled ice 
    144136 
    145137#if defined key_iomput 
    … …  
    152144         lrst_oce = .FALSE. 
    153145      ENDIF 
    154       IF( kstp == nitend .OR. indic < 0 ) THEN 
    155                              CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     146      IF( kstp == nitend .OR. nstop > 0 ) THEN 
     147         CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    156148      ENDIF 
    157149#endif 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/SAS/stpctl.F90

    r12377 r13193  
    2121   USE ice      , ONLY : vt_i, u_ice, tm_i 
    2222   ! 
     23   USE diawri          ! Standard run outputs       (dia_wri_state routine) 
    2324   USE in_out_manager  ! I/O manager 
    2425   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp         ! distributed memory computing 
    26  
     27   ! 
    2728   USE netcdf          ! NetCDF library 
    2829   IMPLICIT NONE 
    … …  
    3132   PUBLIC stp_ctl           ! routine called by step.F90 
    3233 
    33    INTEGER  ::   idrun, idtime, idssh, idu, ids, istatus 
    34    LOGICAL  ::   lsomeoce 
     34   INTEGER                ::   nrunid   ! netcdf file id 
     35   INTEGER, DIMENSION(3)  ::   nvarid   ! netcdf variable id 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    … …  
    3839   !! Software governed by the CeCILL license (see ./LICENSE) 
    3940   !!---------------------------------------------------------------------- 
    40  
    4141CONTAINS 
    4242 
    43    SUBROUTINE stp_ctl( kt, kindic ) 
     43   SUBROUTINE stp_ctl( kt, Kmm ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    4949      !! ** Method  : - Save the time step in numstp 
    5050      !!              - Print it each 50 time steps 
     51      !!              - Stop the run IF problem encountered by setting nstop > 0 
     52      !!                Problems checked: ice thickness maximum > 100 m 
     53      !!                                  ice velocity  maximum > 10 m/s  
     54      !!                                  min ice temperature   < -100 degC 
    5155      !! 
    5256      !! ** Actions :   "time.step" file = last ocean time-step 
    5357      !!                "run.stat"  file = run statistics 
    54       !!                 
    55       !!---------------------------------------------------------------------- 
    56       INTEGER, INTENT( in    ) ::   kt       ! ocean time-step index 
    57       INTEGER, INTENT( inout ) ::   kindic   ! indicator of solver convergence 
    58       !! 
    59       REAL(wp), DIMENSION(3) ::   zmax 
    60       LOGICAL                ::   ll_wrtstp, ll_colruns, ll_wrtruns 
    61       CHARACTER(len=20) :: clname 
    62       !!---------------------------------------------------------------------- 
    63       ! 
    64       ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    65       ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    66       ll_wrtruns = ll_colruns .AND. lwm 
    67       IF( kt == nit000 .AND. lwp ) THEN 
    68          WRITE(numout,*) 
    69          WRITE(numout,*) 'stp_ctl : time-stepping control' 
    70          WRITE(numout,*) '~~~~~~~' 
    71          !                                ! open time.step file 
    72          IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    73          !                                ! open run.stat file(s) at start whatever 
    74          !                                ! the value of sn_cfctl%ptimincr 
    75          IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
     58      !!                 nstop indicator sheared among all local domain 
     59      !!---------------------------------------------------------------------- 
     60      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     61      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
     62      !! 
     63      INTEGER                         ::   ji                                    ! dummy loop indices 
     64      INTEGER                         ::   idtime, istatus 
     65      INTEGER , DIMENSION(4)          ::   iareasum, iareamin, iareamax 
     66      INTEGER , DIMENSION(3,3)        ::   iloc                                  ! min/max loc indices 
     67      REAL(wp)                        ::   zzz                                   ! local real  
     68      REAL(wp), DIMENSION(4)          ::   zmax, zmaxlocal 
     69      LOGICAL                         ::   ll_wrtstp, ll_colruns, ll_wrtruns 
     70      LOGICAL, DIMENSION(jpi,jpj)     ::   llmsk 
     71      CHARACTER(len=20)               ::   clname 
     72      !!---------------------------------------------------------------------- 
     73      IF( nstop > 0 .AND. ngrdstop > -1 )   RETURN   !   stpctl was already called by a child grid 
     74      ! 
     75      ll_wrtstp  = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
     76      ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1  
     77      ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 
     78      ! 
     79      IF( kt == nit000 ) THEN 
     80         ! 
     81         IF( lwp ) THEN 
     82            WRITE(numout,*) 
     83            WRITE(numout,*) 'stp_ctl : time-stepping control' 
     84            WRITE(numout,*) '~~~~~~~' 
     85         ENDIF 
     86         !                                ! open time.step    ascii file, done only by 1st subdomain 
     87         IF( lwm )   CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     88         ! 
     89         IF( ll_wrtruns ) THEN 
     90            !                             ! open run.stat     ascii file, done only by 1st subdomain 
    7691            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     92            !                             ! open run.stat.nc netcdf file, done only by 1st subdomain 
    7793            clname = 'run.stat.nc' 
    7894            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    79             istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 
    80             istatus = NF90_DEF_DIM( idrun, 'time'     , NF90_UNLIMITED, idtime ) 
    81             istatus = NF90_DEF_VAR( idrun, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), idssh ) 
    82             istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 
    83             istatus = NF90_DEF_VAR( idrun, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), ids ) 
    84             istatus = NF90_ENDDEF(idrun) 
    85          ENDIF 
    86       ENDIF 
    87       IF( kt == nit000 )   lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 
    88       ! 
    89       IF(lwm .AND. ll_wrtstp) THEN        !==  current time step  ==!   ("time.step" file) 
     95            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 
     96            istatus = NF90_DEF_DIM( nrunid, 'time'     , NF90_UNLIMITED, idtime ) 
     97            istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 
     98            istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 
     99            istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 
     100            istatus = NF90_ENDDEF(nrunid) 
     101         ENDIF 
     102         !     
     103      ENDIF 
     104      ! 
     105      !                                   !==              write current time step              ==! 
     106      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     107      IF( lwm .AND. ll_wrtstp ) THEN 
    90108         WRITE ( numstp, '(1x, i8)' )   kt 
    91109         REWIND( numstp ) 
    92110      ENDIF 
    93       !                                   !==  test of extrema  ==! 
     111      !                                   !==            test of local extrema           ==! 
     112      !                                   !==  done by all processes at every time step  ==! 
     113      llmsk(:,:) = tmask(:,:,1) == 1._wp 
     114      IF( COUNT( llmsk(:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
     115         zmax(1) = MAXVAL(      vt_i (:,:)            , mask = llmsk )   ! max ice thickness 
     116         zmax(2) = MAXVAL( ABS( u_ice(:,:) )          , mask = llmsk )   ! max ice velocity (zonal only) 
     117         zmax(3) = MAXVAL(     -tm_i (:,:) + 273.15_wp, mask = llmsk )   ! min ice temperature 
     118      ELSE 
     119         IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
     120            zmax(1:3) = -HUGE(1._wp) 
     121         ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
     122            zmax(1:3) = 0._wp 
     123         ENDIF 
     124      ENDIF 
     125      zmax(4) = REAL( nstop, wp )                                     ! stop indicator 
     126      !                                   !==               get global extrema             ==! 
     127      !                                   !==  done by all processes if writting run.stat  ==! 
    94128      IF( ll_colruns ) THEN 
    95          zmax(1) = MAXVAL(      vt_i (:,:) )                                           ! max ice thickness 
    96          zmax(2) = MAXVAL( ABS( u_ice(:,:) ) )                                         ! max ice velocity (zonal only) 
    97          zmax(3) = MAXVAL(     -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp )   ! min ice temperature 
    98          CALL mpp_max( "stpctl", zmax )                                   ! max over the global domain 
     129         zmaxlocal(:) = zmax(:) 
     130         CALL mpp_max( "stpctl", zmax )          ! max over the global domain 
     131         nstop = NINT( zmax(4) )                 ! update nstop indicator (now sheared among all local domains) 
     132      ENDIF 
     133      !                                   !==              write "run.stat" files              ==! 
     134      !                                   !==  done only by 1st subdomain at writting timestep  ==! 
     135      IF( ll_wrtruns ) THEN 
     136         WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3) 
     137         istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 
     138         istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 
     139         istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 
     140         IF( kt == nitend )   istatus = NF90_CLOSE(nrunid) 
    99141      END IF 
    100       !                                            !==  run statistics  ==!   ("run.stat" file) 
    101       IF( ll_wrtruns ) THEN 
    102          WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 
    103          istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 
    104          istatus = NF90_PUT_VAR( idrun,   idu, (/ zmax(2)/), (/kt/), (/1/) ) 
    105          istatus = NF90_PUT_VAR( idrun,   ids, (/-zmax(3)/), (/kt/), (/1/) ) 
    106          IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 
    107          IF( kt == nitend         ) istatus = NF90_CLOSE(idrun) 
    108       END IF 
     142      !                                   !==               error handling               ==! 
     143      !                                   !==  done by all processes at every time step  ==! 
     144      ! 
     145      IF(   zmax(1) >  100._wp .OR.   &                   ! too large ice thickness maximum ( > 100 m) 
     146         &  zmax(2) >   10._wp .OR.   &                   ! too large ice velocity ( > 10 m/s) 
     147         &  zmax(3) >  101._wp .OR.   &                   ! too cold ice temperature ( < -100 degC) 
     148         &  ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR.   &               ! NaN encounter in the tests 
     149         &  ABS(   zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN   ! Infinity encounter in the tests 
     150         ! 
     151         iloc(:,:) = 0 
     152         IF( ll_colruns ) THEN   ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 
     153            ! first: close the netcdf file, so we can read it 
     154            IF( lwm .AND. kt /= nitend )   istatus = NF90_CLOSE(nrunid) 
     155            ! get global loc on the min/max 
     156            CALL mpp_maxloc( 'stpctl',      vt_i(:,:)            , tmask(:,:,1), zzz, iloc(1:2,1) )   ! mpp_maxloc ok if mask = F  
     157            CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) )          , tmask(:,:,1), zzz, iloc(1:2,2) ) 
     158            CALL mpp_minloc( 'stpctl',      tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 
     159            ! find which subdomain has the max. 
     160            iareamin(:) = jpnij+1   ;   iareamax(:) = 0   ;   iareasum(:) = 0 
     161            DO ji = 1, 4 
     162               IF( zmaxlocal(ji) == zmax(ji) ) THEN 
     163                  iareamin(ji) = narea   ;   iareamax(ji) = narea   ;   iareasum(ji) = 1 
     164               ENDIF 
     165            END DO 
     166            CALL mpp_min( "stpctl", iareamin )         ! min over the global domain 
     167            CALL mpp_max( "stpctl", iareamax )         ! max over the global domain 
     168            CALL mpp_sum( "stpctl", iareasum )         ! sum over the global domain 
     169         ELSE                    ! find local min and max locations: 
     170            ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 
     171            iloc(1:2,1) = MAXLOC(       vt_i(:,:)            , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     172            iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) )          , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     173            iloc(1:2,3) = MINLOC(       tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 
     174            iareamin(:) = narea   ;   iareamax(:) = narea   ;   iareasum(:) = 1         ! this is local information 
     175         ENDIF 
     176         ! 
     177         WRITE(ctmp1,*) ' stp_ctl: ice_thick > 100 m or |ice_vel| > 10 m/s or ice_temp < -100 degC or NaN encounter in the tests' 
     178         CALL wrt_line( ctmp2, kt, 'ice_thick max',  zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 
     179         CALL wrt_line( ctmp3, kt, '|ice_vel| max',  zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 
     180         CALL wrt_line( ctmp4, kt, 'ice_temp  min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 
     181         IF( Agrif_Root() ) THEN 
     182            WRITE(ctmp6,*) '      ===> output of last computed fields in output.abort* files' 
     183         ELSE 
     184            WRITE(ctmp6,*) '      ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 
     185         ENDIF 
     186         ! 
     187         CALL dia_wri_state( Kmm, 'output.abort' )     ! create an output.abort file 
     188         ! 
     189         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
     190            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     191            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     192            ENDIF 
     193         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
     194            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     195         ENDIF 
     196         ! 
     197      ENDIF 
     198      ! 
     199      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     200         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     201         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
     202      ENDIF 
    109203      ! 
    1102049500  FORMAT(' it :', i8, '    vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 
    111205      ! 
    112206   END SUBROUTINE stp_ctl 
     207 
     208 
     209   SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 
     210      !!---------------------------------------------------------------------- 
     211      !!                     ***  ROUTINE wrt_line  *** 
     212      !! 
     213      !! ** Purpose :   write information line 
     214      !! 
     215      !!---------------------------------------------------------------------- 
     216      CHARACTER(len=*),      INTENT(  out) ::   cdline 
     217      CHARACTER(len=*),      INTENT(in   ) ::   cdprefix 
     218      REAL(wp),              INTENT(in   ) ::   pval 
     219      INTEGER, DIMENSION(3), INTENT(in   ) ::   kloc 
     220      INTEGER,               INTENT(in   ) ::   kt, ksum, kmin, kmax 
     221      ! 
     222      CHARACTER(len=80) ::   clsuff 
     223      CHARACTER(len=9 ) ::   clkt, clsum, clmin, clmax 
     224      CHARACTER(len=9 ) ::   cli, clj, clk 
     225      CHARACTER(len=1 ) ::   clfmt 
     226      CHARACTER(len=4 ) ::   cl4   ! needed to be able to compile with Agrif, I don't know why 
     227      INTEGER           ::   ifmtk 
     228      !!---------------------------------------------------------------------- 
     229      WRITE(clkt , '(i9)') kt 
     230       
     231      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij  ,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     232      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
     233      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
     234      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
     235      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
     236                                   WRITE(clmax, cl4) kmax-1 
     237      ! 
     238      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1      ! how many digits to we need to write jpiglo? (we decide max = 9) 
     239      cl4 = '(i'//clfmt//')'   ;   WRITE(cli, cl4) kloc(1)      ! this is ok with AGRIF 
     240      WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1      ! how many digits to we need to write jpjglo? (we decide max = 9) 
     241      cl4 = '(i'//clfmt//')'   ;   WRITE(clj, cl4) kloc(2)      ! this is ok with AGRIF 
     242      ! 
     243      IF( ksum == 1 ) THEN   ;   WRITE(clsuff,9100) TRIM(clmin) 
     244      ELSE                   ;   WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 
     245      ENDIF 
     246      IF(kloc(3) == 0) THEN 
     247         ifmtk = INT(LOG10(REAL(jpk,wp))) + 1                   ! how many digits to we need to write jpk? (we decide max = 9) 
     248         clk = REPEAT(' ', ifmtk)                               ! create the equivalent in blank string 
     249         WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 
     250      ELSE 
     251         WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1      ! how many digits to we need to write jpk? (we decide max = 9) 
     252         !!! WRITE(clk, '(i'//clfmt//')') kloc(3)               ! this is creating a compilation error with AGRIF 
     253         cl4 = '(i'//clfmt//')'   ;   WRITE(clk, cl4) kloc(3)   ! this is ok with AGRIF 
     254         WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj),    TRIM(clk), TRIM(clsuff) 
     255      ENDIF 
     256      ! 
     2579100  FORMAT('MPI rank ', a) 
     2589200  FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 
     2599300  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j   ', a, ' ', a, ' ', a, ' ', a) 
     2609400  FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 
     261      ! 
     262   END SUBROUTINE wrt_line 
     263 
    113264 
    114265   !!====================================================================== 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12377 r13193  
    6969      REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta 
    7070      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    71       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     71      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq  
     72      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    7273      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn 
    7374      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof 
    … …  
    156157         zgrazing2(ji,jj,jk) = zgraztotc 
    157158 
    158          !    Mesozooplankton efficiency 
    159          !    -------------------------- 
     159         ! Mesozooplankton efficiency.  
     160         ! We adopt a formulation proposed by Mitra et al. (2007) 
     161         ! The gross growth efficiency is controled by the most limiting nutrient. 
     162         ! Growth is also further decreased when the food quality is poor. This is currently 
     163         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     164         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     165         ! Fulton, 2012) 
     166         ! ----------------------------------------------------------------------------------- 
    160167         zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    161168         zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
    … …  
    163170         zbeta     = MAX(0., (epsher2 - epsher2min) ) 
    164171         zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )  
    165          zepsherv  = zepsherf * zepshert  
     172         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     173         zepsherv  = zepsherf * zepshert * zepsherq  
    166174 
    167175         zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
    … …  
    170178         &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    171179         zgrapoc2  = zgraztotc * unass2 
     180 
    172181 
    173182         !   Update the arrays TRA which contain the biological sources and sinks 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zmicro.F90

    r12377 r13193  
    6767      REAL(wp) :: zgraze  , zdenom, zdenom2 
    6868      REAL(wp) :: zfact   , zfood, zfoodlim, zbeta 
    69       REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
     69      REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 
     70      REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    7071      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    7172      REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn 
    … …  
    119120         zgrazing(ji,jj,jk) = zgraztotc 
    120121 
    121          !    Various remineralization and excretion terms 
    122          !    -------------------------------------------- 
     122 
     123         ! Microzooplankton efficiency.  
     124         ! We adopt a formulation proposed by Mitra et al. (2007) 
     125         ! The gross growth efficiency is controled by the most limiting nutrient. 
     126         ! Growth is also further decreased when the food quality is poor. This is currently 
     127         ! hard coded : it can be decreased by up to 50% (zepsherq) 
     128         ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     129         ! Fulton, 2012) 
     130         ! ----------------------------------------------------------------------------- 
    123131         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 
    124132         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) 
    … …  
    126134         zbeta     = MAX(0., (epsher - epshermin) ) 
    127135         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
    128          zepsherv  = zepsherf * zepshert  
     136         zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
     137         zepsherv  = zepsherf * zepshert * zepsherq  
    129138 
    130139         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv )  

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsms.F90

    r12724 r13193  
    207207      IF( l_trdtrc ) THEN 
    208208         DO jn = jp_pcs0, jp_pcs1 
    209            ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r  
     209           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
    210210           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    211211         END DO 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/sedchem.F90

    r12377 r13193  
    577577         saltprac(:) = salt(:) * 35.0 / 35.16504 
    578578      ELSE 
    579          saltprac(:) = temp(:) 
     579         saltprac(:) = salt(:) 
    580580      ENDIF 
    581581 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/sedinorg.F90

    r10225 r13193  
    8989            zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk) 
    9090         END DO 
     91         zsolcpsi = MAX( zsolcpsi, rtrn ) 
    9192         zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 ) 
    9293         zsieq(ji) = MAX( rtrn, sieqs(ji) ) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcbc.F90

    r12779 r13193  
    152152               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 )  & 
    153153                   & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 
    154                IF(  .NOT.( 0 < nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
     154               IF(  .NOT.( 0 <= nn_trcdmp_bdy(ib)  .AND.  nn_trcdmp_bdy(ib) <= 2 )  )   & 
    155155                   & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
    156156            END DO 
Note: See TracChangeset for help on using the changeset viewer.