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 12695 for NEMO – NEMO

Changeset 12695 for NEMO


Ignore:
Timestamp:
2020-04-06T20:05:54+02:00 (4 years ago)
Author:
mathiot
Message:

update branch to head of trunk

Location:
NEMO/branches/2020/ticket2406_trunk
Files:
48 edited
1 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/ticket2406_trunk/cfgs/ref_cfgs.txt

    r12377 r12695  
    77ORCA2_OFF_TRC OCE TOP OFF 
    88ORCA2_SAS_ICE OCE ICE NST SAS 
    9 ORCA2_ICE_PISCES OCE TOP ICE NST 
     9ORCA2_ICE_PISCES OCE TOP ICE NST ABL 
    1010ORCA2_ICE_ABL OCE ICE ABL 
    11 ORCA2_SAS_ICE_ABL OCE SAS ICE ABL 
    12 ORCA2_ICE OCE ICE 
    1311SPITZ12 OCE ICE 
    1412WED025 OCE ICE 
    15 eORCA025_ICE OCE ICE 
    16 eORCA025_ICE_ABL OCE ICE ABL 
    17 eORCA025_SAS_ICE_ABL OCE SAS ICE ABL 

  • NEMO/branches/2020/ticket2406_trunk/src/ABL/ablrst.F90

    r11945 r12695  
    7474            ENDIF 
    7575            ! 
    76             CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka ) 
     76            CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' ) 
    7777            lrst_abl = .TRUE. 
    7878         ENDIF 
    … …  
    146146      ENDIF 
    147147 
    148       CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar, kdlev = jpka ) 
     148      CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar ) 
    149149 
    150150      ! Time info 

  • NEMO/branches/2020/ticket2406_trunk/src/ABL/sbcabl.F90

    r12489 r12695  
    7575      !!--------------------------------------------------------------------- 
    7676 
    77       REWIND( numnam_ref )              ! Namelist namsbc_abl in reference namelist : ABL parameters 
     77      ! Namelist namsbc_abl in reference namelist : ABL parameters 
    7878      READ  ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) 
    7979901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) 
    80       ! 
    81       REWIND( numnam_cfg )              ! Namelist namsbc_abl in configuration namelist : ABL parameters 
     80      ! Namelist namsbc_abl in configuration namelist : ABL parameters 
    8281      READ  ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) 
    8382902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) 

  • NEMO/branches/2020/ticket2406_trunk/src/ICE/icectl.F90

    r12489 r12695  
    331331      IF(lwp) WRITE(numout,*)                 
    332332 
    333       CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     333      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    334334       
    335335      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
    … …  
    725725       
    726726      CALL prt_ctl_info(' ') 
    727       CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    728       CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    729       CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    730       CALL prt_ctl(tab2d_1=qsr    , clinfo1= ' qsr   : ', tab2d_2=qns       , clinfo2= ' qns       : ') 
    731       CALL prt_ctl(tab2d_1=emp    , clinfo1= ' emp   : ', tab2d_2=sfx       , clinfo2= ' sfx       : ') 
    732        
    733       CALL prt_ctl_info(' ') 
    734727      CALL prt_ctl_info(' - Stresses : ') 
    735728      CALL prt_ctl_info('   ~~~~~~~~~~ ') 

  • NEMO/branches/2020/ticket2406_trunk/src/ICE/iceistate.F90

    r12489 r12695  
    436436!!clem: output of initial state should be written here but it is impossible because 
    437437!!      the ocean and ice are in the same file 
    438 !!      CALL dia_wri_state( 'output.init' ) 
     438!!      CALL dia_wri_state( Kmm, 'output.init' ) 
    439439      ! 
    440440   END SUBROUTINE ice_istate 

  • NEMO/branches/2020/ticket2406_trunk/src/ICE/icerst.F90

    r12377 r12695  
    8080            ENDIF 
    8181            ! 
    82             CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl ) 
     82            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    8383            lrst_ice = .TRUE. 
    8484         ENDIF 
    … …  
    185185      ENDIF 
    186186 
    187       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 
     187      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 
    188188 
    189189      ! test if v_i exists  

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/BDY/bdydta.F90

    r12396 r12695  
    9292      INTEGER ::  ii, ij, ik, igrd, ipl               ! local integers 
    9393      INTEGER,   DIMENSION(jpbgrd)     ::   ilen1  
    94       INTEGER,   DIMENSION(:), POINTER ::   nblen, nblenrim  ! short cuts 
    9594      TYPE(OBC_DATA)         , POINTER ::   dta_alias        ! short cut 
    9695      TYPE(FLD), DIMENSION(:), POINTER ::   bf_alias 
    … …  
    108107         DO jbdy = 1, nb_bdy 
    109108            ! 
    110             nblen    => idx_bdy(jbdy)%nblen 
    111             nblenrim => idx_bdy(jbdy)%nblenrim 
    112             ! 
    113109            IF( nn_dyn2d_dta(jbdy) == 0 ) THEN  
    114                ilen1(:) = nblen(:) 
    115110               IF( dta_bdy(jbdy)%lneed_ssh ) THEN  
    116111                  igrd = 1 
    117                   DO ib = 1, ilen1(igrd) 
     112                  DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)   ! ssh is allocated and used only on the rim 
    118113                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    119114                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    121116                  END DO 
    122117               ENDIF 
    123                IF( dta_bdy(jbdy)%lneed_dyn2d) THEN  
     118               IF( dta_bdy(jbdy)%lneed_dyn2d .AND. ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN   ! no SIZE with a unassociated pointer 
    124119                  igrd = 2 
    125                   DO ib = 1, ilen1(igrd) 
     120                  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 
    126121                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    127122                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    129124                  END DO 
    130125                  igrd = 3 
    131                   DO ib = 1, ilen1(igrd) 
     126                  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 
    132127                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    133128                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    138133            ! 
    139134            IF( nn_dyn3d_dta(jbdy) == 0 ) THEN  
    140                ilen1(:) = nblen(:) 
    141135               IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN  
    142136                  igrd = 2  
    143                   DO ib = 1, ilen1(igrd) 
     137                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    144138                     DO ik = 1, jpkm1 
    145139                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    149143                  END DO 
    150144                  igrd = 3  
    151                   DO ib = 1, ilen1(igrd) 
     145                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    152146                     DO ik = 1, jpkm1 
    153147                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    160154 
    161155            IF( nn_tra_dta(jbdy) == 0 ) THEN  
    162                ilen1(:) = nblen(:) 
    163156               IF( dta_bdy(jbdy)%lneed_tra ) THEN 
    164157                  igrd = 1  
    165                   DO ib = 1, ilen1(igrd) 
     158                  DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    166159                     DO ik = 1, jpkm1 
    167160                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    … …  
    176169#if defined key_si3 
    177170            IF( nn_ice_dta(jbdy) == 0 ) THEN    ! set ice to initial values 
    178                ilen1(:) = nblen(:) 
    179171               IF( dta_bdy(jbdy)%lneed_ice ) THEN 
    180172                  igrd = 1    
    181173                  DO jl = 1, jpl 
    182                      DO ib = 1, ilen1(igrd) 
     174                     DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    183175                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    184176                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    … …  
    236228         ! tidal harmonic forcing ONLY: initialise arrays 
    237229         IF( nn_dyn2d_dta(jbdy) == 2 ) THEN   ! we did not read ssh, u/v2d  
    238             IF( dta_alias%lneed_ssh   ) dta_alias%ssh(:) = 0._wp 
    239             IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 
    240             IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 
     230            IF( dta_alias%lneed_ssh   .AND. ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 
     231            IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 
     232            IF( dta_alias%lneed_dyn2d .AND. ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 
    241233         ENDIF 
    242234 
    … …  
    245237            ! 
    246238            igrd = 2                       ! zonal velocity 
    247             dta_alias%u2d(:) = 0._wp       ! compute barotrope zonal velocity and put it in u2d 
    248239            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    249240               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    250241               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     242               dta_alias%u2d(ib) = 0._wp   ! compute barotrope zonal velocity and put it in u2d 
    251243               DO ik = 1, jpkm1 
    252244                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
    … …  
    258250            END DO 
    259251            igrd = 3                       ! meridional velocity 
    260             dta_alias%v2d(:) = 0._wp       ! compute barotrope meridional velocity and put it in v2d 
    261252            DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 
    262253               ii   = idx_bdy(jbdy)%nbi(ib,igrd) 
    263254               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
     255               dta_alias%v2d(ib) = 0._wp   ! compute barotrope meridional velocity and put it in v2d 
    264256               DO ik = 1, jpkm1 
    265257                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
    … …  
    283275 
    284276#if defined key_si3 
    285          IF( dta_alias%lneed_ice ) THEN 
     277         IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 
    286278            ! fill temperature and salinity arrays 
    287279            IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 
    … …  
    338330            DO jbdy = 1, nb_bdy      ! Tidal component added in ts loop 
    339331               IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    340                   nblen => idx_bdy(jbdy)%nblen 
    341                   nblenrim => idx_bdy(jbdy)%nblenrim 
    342                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=nblen(:) 
    343                   ELSE                                 ;   ilen1(:)=nblenrim(:) 
     332                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=idx_bdy(jbdy)%nblen(:) 
     333                  ELSE                                 ;   ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 
    344334                  ENDIF 
    345335                  IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/DIA/diaar5.F90

    r12489 r12695  
    3232   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
    3333   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain) 
    34    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain) 
    3534   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3635   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
    … …  
    5453      !!---------------------------------------------------------------------- 
    5554      ! 
    56       ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     55      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
    5756      ! 
    5857      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
    … …  
    9089         ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
    9190         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    92          zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 
    93       ENDIF 
    94       ! 
    95       CALL iom_put( 'e2u'      , e2u (:,:) ) 
    96       CALL iom_put( 'e1v'      , e1v (:,:) ) 
    97       CALL iom_put( 'areacello', area(:,:) ) 
     91         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 
     92      ENDIF 
     93      ! 
     94      CALL iom_put( 'e2u'      , e2u  (:,:) ) 
     95      CALL iom_put( 'e1v'      , e1v  (:,:) ) 
     96      CALL iom_put( 'areacello', e1e2t(:,:) ) 
    9897      ! 
    9998      IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' )  ) THEN   
    10099         zrhd(:,:,jpk) = 0._wp        ! ocean volume ; rhd is used as workspace 
    101100         DO jk = 1, jpkm1 
    102             zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     101            zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    103102         END DO 
    104103         CALL iom_put( 'volcello'  , zrhd(:,:,:)  )  ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 
    … …  
    151150         END IF 
    152151         !                                          
    153          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     152         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    154153         zssh_steric = - zarho / area_tot 
    155154         CALL iom_put( 'sshthster', zssh_steric ) 
    … …  
    177176         END IF 
    178177         !     
    179          zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )  
     178         zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) )  
    180179         zssh_steric = - zarho / area_tot 
    181180         CALL iom_put( 'sshsteric', zssh_steric ) 
    … …  
    191190          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    192191          DO_3D_11_11( 1, jpkm1 ) 
    193              zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     192             zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    194193             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
    195194             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
    … …  
    237236               z2d(:,:) = 0._wp 
    238237               DO jk = 1, jpkm1 
    239                  z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
     238                 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 
    240239               END DO 
    241240               ztemp = glob_sum( 'diaar5', z2d(:,:)  )  
    … …  
    244243             ! 
    245244             IF( iom_use( 'ssttot' ) ) THEN   ! Output potential temperature in case we use TEOS-10 
    246                zsst = glob_sum( 'diaar5',  area(:,:) * ztpot(:,:,1)  )  
     245               zsst = glob_sum( 'diaar5',  e1e2t(:,:) * ztpot(:,:,1)  )  
    247246               CALL iom_put( 'ssttot', zsst / area_tot ) 
    248247             ENDIF 
    … …  
    259258      ELSE        
    260259         IF( iom_use('ssttot') ) THEN   ! Output sst in case we use EOS-80 
    261             zsst  = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
     260            zsst  = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 
    262261            CALL iom_put('ssttot', zsst / area_tot ) 
    263262         ENDIF 
    … …  
    375374         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    376375 
    377          area(:,:) = e1e2t(:,:) 
    378          area_tot  = glob_sum( 'diaar5', area(:,:) ) 
     376         area_tot  = glob_sum( 'diaar5', e1e2t(:,:) ) 
    379377 
    380378         ALLOCATE( zvol0(jpi,jpj) ) 
    … …  
    383381         DO_3D_11_11( 1, jpkm1 ) 
    384382            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    385             zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
     383            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * e1e2t(ji,jj) 
    386384            thick0(ji,jj) = thick0(ji,jj) +  idep     
    387385         END_3D 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/DIA/diamlr.F90

    r12377 r12695  
    8484      INTEGER                                     ::   itide                       ! Number of available tidal components 
    8585      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0 
    86       CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = ' n/a ' 
     86      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = 'n/a ' 
    8787      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst 
    8888 
    … …  
    145145            ! Retrieve information (frequency, phase, nodal correction) about all 
    146146            ! available tidal constituents for placeholder substitution below 
    147             ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf',    & 
    148                &                      'Msqm', 'Sa', 'K1', 'O1', 'P1',     & 
    149                &                      'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 
    150                &                      'K2', 'nu2', 'mu2', '2N2', 'L2',    & 
    151                &                      'T2', 'eps2', 'lam2', 'R2', 'M3',   & 
    152                &                      'MKS2', 'MN4', 'MS4', 'M4', 'N4',   & 
    153                &                      'S4', 'M6', 'M8' /) 
     147            ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
     148            ctide_selected(1:34) = (/ 'Mf  ', 'Mm  ', 'Ssa ', 'Mtm ', 'Msf ',         & 
     149               &                      'Msqm', 'Sa  ', 'K1  ', 'O1  ', 'P1  ',         & 
     150               &                      'Q1  ', 'J1  ', 'S1  ', 'M2  ', 'S2  ', 'N2  ', & 
     151               &                      'K2  ', 'nu2 ', 'mu2 ', '2N2 ', 'L2  ',         & 
     152               &                      'T2  ', 'eps2', 'lam2', 'R2  ', 'M3  ',         & 
     153               &                      'MKS2', 'MN4 ', 'MS4 ', 'M4  ', 'N4  ',         & 
     154               &                      'S4  ', 'M6  ', 'M8  ' /) 
    154155            CALL tide_init_harmonics(ctide_selected, stideconst) 
    155156            itide = size(stideconst) 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/DIA/diawri.F90

    r12493 r12695  
    924924      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    925925      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    926  
    927 #if defined key_si3 
    928      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    929 #else 
    930      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    931 #endif 
    932  
     926      ! 
     927      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     928      ! 
    933929      CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) )    ! now temperature 
    934930      CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) )    ! now salinity 
    … …  
    943939      CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep            )    ! now k-velocity 
    944940      CALL iom_rstput( 0, 0, inum, 'ht'     , ht                 )    ! now water column height 
    945  
     941      ! 
    946942      IF ( ln_isf ) THEN 
    947943         IF (ln_isfcav_mlt) THEN 
    … …  
    949945            CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav    )    ! now k-velocity 
    950946            CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav    )    ! now k-velocity 
    951             CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,8)    )    ! now k-velocity 
    952             CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,8)    )    ! now k-velocity 
    953             CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,8), ktype = jp_i1 ) 
     947            CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) )    ! now k-velocity 
     948            CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) )    ! now k-velocity 
     949            CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 
    954950         END IF 
    955951         IF (ln_isfpar_mlt) THEN 
    956             CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,8) )    ! now k-velocity 
     952            CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) )    ! now k-velocity 
    957953            CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par          )    ! now k-velocity 
    958954            CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par    )    ! now k-velocity 
    959955            CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par    )    ! now k-velocity 
    960             CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,8)    )    ! now k-velocity 
    961             CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,8)    )    ! now k-velocity 
    962             CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,8), ktype = jp_i1 ) 
     956            CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) )    ! now k-velocity 
     957            CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) )    ! now k-velocity 
     958            CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 
    963959         END IF 
    964960      END IF 
    965  
     961      ! 
    966962      IF( ALLOCATED(ahtu) ) THEN 
    967963         CALL iom_rstput( 0, 0, inum,  'ahtu', ahtu              )    ! aht at u-point 
    … …  
    993989         CALL iom_rstput ( 0, 0, inum, "qz1_abl",  tq_abl(:,:,2,nt_a,2) )   ! now first level humidity 
    994990      ENDIF 
    995   
     991      ! 
     992      CALL iom_close( inum ) 
     993      !  
    996994#if defined key_si3 
    997995      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     996         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    998997         CALL ice_wri_state( inum ) 
     998         CALL iom_close( inum ) 
    999999      ENDIF 
    10001000#endif 
    1001       ! 
    1002       CALL iom_close( inum ) 
    1003       !  
     1001 
    10041002   END SUBROUTINE dia_wri_state 
    10051003 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/FLO/floblk.F90

    r12489 r12695  
    175175            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 
    176176            IF( zufl(jfl)*zuoutfl <= 0. ) THEN 
    177                ztxfl(jfl) = 1.E99 
     177               ztxfl(jfl) = HUGE(1._wp) 
    178178            ELSE 
    179179               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    191191            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 
    192192            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 
    193                ztyfl(jfl) = 1.E99 
     193               ztyfl(jfl) = HUGE(1._wp) 
    194194            ELSE 
    195195               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
    … …  
    208208               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 
    209209               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 
    210                   ztzfl(jfl) = 1.E99 
     210                  ztzfl(jfl) = HUGE(1._wp) 
    211211               ELSE 
    212212                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/IOM/iom.F90

    r12489 r12695  
    111111      CHARACTER(len=lc) :: clname 
    112112      INTEGER             :: irefyear, irefmonth, irefday 
    113       INTEGER           :: ji, jkmin 
     113      INTEGER           :: ji 
    114114      LOGICAL :: llrst_context              ! is context related to restart 
    115115      ! 
    … …  
    220220           
    221221          ! Add vertical grid bounds 
    222           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    223           zt_bnds(2,:        ) = gdept_1d(:) 
    224           zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
    225           zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
    226           zw_bnds(1,:        ) = gdepw_1d(:) 
    227           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    228           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     222          zt_bnds(2,:      ) = gdept_1d(:) 
     223          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1) 
     224          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1) 
     225          zw_bnds(1,:      ) = gdepw_1d(:) 
     226          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     227          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    229228          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
    230229          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
    … …  
    665664 
    666665 
    667    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     666   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
    668667      !!--------------------------------------------------------------------- 
    669668      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    678677      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    679678      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
     679      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open 
    680680      ! 
    681681      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    … …  
    823823      ENDIF 
    824824      IF( istop == nstop ) THEN   ! no error within this routine 
    825          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
     825         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
    826826      ENDIF 
    827827      ! 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/IOM/iom_def.F90

    r12377 r12695  
    5050   TYPE, PUBLIC ::   file_descriptor 
    5151      CHARACTER(LEN=240)                        ::   name     !: name of the file 
     52      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...) 
    5253      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed) 
    5354                                                              !: jpioipsl option has been removed) 
    … …  
    6465      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6566      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
    66       INTEGER                                   ::   nlev     ! number of vertical levels 
    6767   END TYPE file_descriptor 
    6868   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/IOM/iom_nf90.F90

    r12377 r12695  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
    21    USE sbc_oce, ONLY: jpka, ght_abl ! abl vertical level number and height 
     21   USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 
    2222   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2323   USE iom_def         ! iom variables definitions 
    … …  
    4646CONTAINS 
    4747 
    48    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 
     48   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5858      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    5959      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
     60      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    6061 
    6162      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6263      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     64      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
    6365      INTEGER            ::   iln              ! lengths of character 
    6466      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    7072      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7173      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    72       INTEGER            ::   ilevels          ! vertical levels 
    7374      !--------------------------------------------------------------------- 
    7475      ! 
    … …  
    7778      ! 
    7879      !                 !number of vertical levels 
    79       IF( PRESENT(kdlev) )   THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice and abl) 
    80       ELSE                          ;   ilevels = jpk      ! by default jpk 
     80      IF( PRESENT(cdcomp) )   THEN 
     81         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 
     82         clcomp = cdcomp    ! use input value 
     83      ELSE 
     84         clcomp = 'OCE'     ! by default  
    8185      ENDIF 
    8286      ! 
    … …  
    125129            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    126130            ! define dimensions 
    127             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
    129             IF( PRESENT(kdlev) ) THEN 
    130               IF( kdlev == jpka ) THEN 
    131                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',          kdlev, idmy ), clinfo) 
    132                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    133               ELSE 
    134                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
    135                  CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    136                  CALL iom_nf90_check(NF90_DEF_DIM( if90id,  'numcat',          kdlev, idmy ), clinfo) 
    137               ENDIF 
    138             ELSE 
    139                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev',            jpk, idmy ), clinfo) 
    140                CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    141             ENDIF 
     131                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
     132                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     133            SELECT CASE (clcomp) 
     134            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
     135            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
     136            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
     137            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     138            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
     139            END SELECT 
     140                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    142141            ! global attributes 
    143142            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    … …  
    165164         ENDDO 
    166165         iom_file(kiomid)%name   = TRIM(cdname) 
     166         iom_file(kiomid)%comp   = clcomp 
    167167         iom_file(kiomid)%nfid   = if90id 
    168168         iom_file(kiomid)%nvars  = 0 
    169169         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    170          iom_file(kiomid)%nlev   = ilevels 
    171170         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    172171         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    … …  
    529528      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    530529      CHARACTER(LEN=256)    :: clinfo               ! info character 
    531       CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character 
    532530      INTEGER               :: if90id               ! nf90 file identifier 
    533       INTEGER               :: idmy                 ! dummy variable 
    534531      INTEGER               :: itype                ! variable type 
    535532      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using 
    … …  
    540537      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
    541538      INTEGER               :: idlv                 ! local variable 
    542       INTEGER               :: idim3                ! id of the third dimension 
    543539      !--------------------------------------------------------------------- 
    544540      ! 
    … …  
    554550         ENDIF 
    555551         ! define the dimension variables if it is not already done 
    556          ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
    557          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)    
    558          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    559          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
    560          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo) 
    561          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo) 
     552         DO jd = 1, 2 
     553            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 
     554            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   & 
     555               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     556         END DO 
     557         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable 
     558         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable 
     559         DO jd = 3, 4 
     560            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 
     561            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   & 
     562               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     563         END DO 
    562564         ! update informations structure related the dimension variable we just added... 
    563565         iom_file(kiomid)%nvars       = 4 
    564566         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
    565          iom_file(kiomid)%cn_var(1:4) = cltmp(1:4) 
    566567         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
    567          IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension 
    568             CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo) 
    569             iom_file(kiomid)%nvars     = 5 
    570             iom_file(kiomid)%luld(5)   = .FALSE. 
    571             iom_file(kiomid)%cn_var(5) = cltmp(5) 
    572             iom_file(kiomid)%ndims(5)  = 1 
    573          ENDIF 
    574          ! trick: defined to 0 to say that dimension variables are defined but not yet written 
    575          iom_file(kiomid)%dimsz(1, 1)  = 0    
    576568         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    577569      ENDIF 
    … …  
    594586         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    595587         ELSEIF( PRESENT(pv_r1d) ) THEN 
    596             IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN   ;   idim3 = 3 
    597             ELSE                                                               ;   idim3 = 5 
    598             ENDIF 
    599                                               idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    600          ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
     588                                              idims = 2   ;   idimid(1:idims) = (/3,4/) 
     589         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2,4/) 
    601590         ELSEIF( PRESENT(pv_r3d) ) THEN 
    602             IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN   ;   idim3 = 3 
    603             ELSE                                                               ;   idim3 = 5 
    604             ENDIF 
    605                                               idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
     591                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/) 
    606592         ENDIF 
    607593         IF( PRESENT(ktype) ) THEN   ! variable external type 
    … …  
    678664            ! ============= 
    679665            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    680             IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    681                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo ) 
    682                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
    683                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo ) 
    684                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    685                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
    686                IF (iom_file(kiomid)%nlev == jpka) THEN   ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy,  ght_abl), clinfo ) 
    687                ELSE                                      ;   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d), clinfo ) 
    688                ENDIF 
    689                IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    690                   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 
    691                ENDIF 
    692                ! +++ WRONG VALUE: to be improved but not really useful... 
    693                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 
    694                CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )    
    695                ! update the values of the variables dimensions size 
    696                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 
    697                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 
    698                iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    699                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 
    700                iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     666            IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0 
     667               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
     668               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
     669               SELECT CASE (iom_file(kiomid)%comp) 
     670               CASE ('OCE')   
     671                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo ) 
     672               CASE ('ABL') 
     673                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo ) 
     674               CASE DEFAULT 
     675                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 
     676               END SELECT 
     677               ! "wrong" value: to be improved but not really useful... 
     678               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )    
     679               ! update the size of the variable corresponding to the unlimited dimension 
     680               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more... 
    701681               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    702682            ENDIF 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk.F90

    r12489 r12695  
    639639      END IF 
    640640 
    641       !!      CALL iom_put( "Cd_oce", zcd_oce)  ! output value of pure ocean-atm. transfer coef. 
    642       !!      CALL iom_put( "Ch_oce", zch_oce)  ! output value of pure ocean-atm. transfer coef. 
    643  
    644       IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
    645          !! If zu == zt, then ensuring once for all that: 
    646          t_zu(:,:) = ztpot(:,:) 
    647          q_zu(:,:) = zqair(:,:) 
    648       ENDIF 
    649  
    650  
    651641      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
    652642      ! ------------------------------------------------------------- 
    … …  
    663653      ELSE                      !==  BLK formulation  ==!   turbulent fluxes computation 
    664654         CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 
    665             &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),         & 
    666             &               wndm(:,:), zU_zu(:,:), pslp(:,:),                 & 
    667             &               taum(:,:), psen(:,:), zqla(:,:),                  & 
    668             &               pEvap=pevp(:,:), prhoa=rhoa(:,:) ) 
     655            &               zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:),          & 
     656            &               wndm(:,:), zU_zu(:,:), pslp(:,:),                  & 
     657            &               taum(:,:), psen(:,:), zqla(:,:),                   & 
     658            &               pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 
    669659 
    670660         zqla(:,:) = zqla(:,:) * tmask(:,:,1) 
    … …  
    10461036      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub    ! sublimation 
    10471037      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub    ! d(sublimation)/dT 
    1048       zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )   ! evaporation over ocean 
     1038      zevap    (:,:)   = emp(:,:) + tprecip(:,:)   ! evaporation over ocean  !LB: removed rn_efac here, correct??? 
    10491039 
    10501040      ! --- evaporation minus precipitation --- ! 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r12377 r12695  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
    … …  
    396395      ! 
    397396      DO_2D_11_11 
    398          ! 
    399          zw = pwnd(ji,jj)   ! wind speed 
    400          ! 
    401          ! Charnock's constant, increases with the wind : 
    402          zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
    403          zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
    404          ! 
    405          alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
    406             &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
    407             &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
    408          ! 
     397      ! 
     398      zw = pwnd(ji,jj)   ! wind speed 
     399      ! 
     400      ! Charnock's constant, increases with the wind : 
     401      zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10))  ! If zw<10. --> 0, else --> 1 
     402      zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 
     403      ! 
     404      alfa_charn_3p0(ji,jj) =  (1. - zgt10)*0.011    &    ! wind is lower than 10 m/s 
     405         &     + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 
     406         &      *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) )    ! Hare et al. (1999) 
     407      ! 
    409408      END_2D 
    410409      ! 
    … …  
    432431      ! 
    433432      DO_2D_11_11 
    434          ! 
    435          zta = pzeta(ji,jj) 
    436          ! 
    437          zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    438          ! 
    439          zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    440             & - 2.*ATAN(zphi_m) + 0.5*rpi 
    441          ! 
    442          zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    443          ! 
    444          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    445             &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    446          ! 
    447          zf = zta*zta 
    448          zf = zf/(1. + zf) 
    449          zc = MIN(50._wp, 0.35_wp*zta) 
    450          zstab = 0.5 + SIGN(0.5_wp, zta) 
    451          ! 
    452          psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    453             &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    454             &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    455          ! 
     433      ! 
     434      zta = pzeta(ji,jj) 
     435      ! 
     436      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     437      ! 
     438      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     439         & - 2.*ATAN(zphi_m) + 0.5*rpi 
     440      ! 
     441      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     442      ! 
     443      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     444         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     445      ! 
     446      zf = zta*zta 
     447      zf = zf/(1. + zf) 
     448      zc = MIN(50._wp, 0.35_wp*zta) 
     449      zstab = 0.5 + SIGN(0.5_wp, zta) 
     450      ! 
     451      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     452         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     453         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
     454      ! 
    456455      END_2D 
    457456      ! 
    … …  
    483482      ! 
    484483      DO_2D_11_11 
    485          ! 
    486          zta = pzeta(ji,jj) 
    487          ! 
    488          zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    489          ! 
    490          zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    491          ! 
    492          zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    493          ! 
    494          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    495             &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    496          ! 
    497          zf = zta*zta 
    498          zf = zf/(1. + zf) 
    499          zc = MIN(50._wp,0.35_wp*zta) 
    500          zstab = 0.5 + SIGN(0.5_wp, zta) 
    501          ! 
    502          psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    503             &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    504             &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505          ! 
     484      ! 
     485      zta = pzeta(ji,jj) 
     486      ! 
     487      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     488      ! 
     489      zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     490      ! 
     491      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     492      ! 
     493      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     494         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     495      ! 
     496      zf = zta*zta 
     497      zf = zf/(1. + zf) 
     498      zc = MIN(50._wp,0.35_wp*zta) 
     499      zstab = 0.5 + SIGN(0.5_wp, zta) 
     500      ! 
     501      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     502         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     503         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
     504      ! 
    506505      END_2D 
    507506      ! 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r12377 r12695  
    194194      IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    195195 
    196       l_zt_equal_zu = .FALSE. 
    197       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     196      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    198197      IF( .NOT. l_zt_equal_zu )  ALLOCATE( zeta_t(jpi,jpj) ) 
    199198 
    … …  
    432431      ! 
    433432      DO_2D_11_11 
    434          ! 
    435          zta = pzeta(ji,jj) 
    436          ! 
    437          zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
    438          ! 
    439          zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
    440             & - 2.*ATAN(zphi_m) + 0.5*rpi 
    441          ! 
    442          zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
    443          ! 
    444          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    445             &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    446          ! 
    447          zf = zta*zta 
    448          zf = zf/(1. + zf) 
    449          zc = MIN(50._wp, 0.35_wp*zta) 
    450          zstab = 0.5 + SIGN(0.5_wp, zta) 
    451          ! 
    452          psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
    453             &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
    454             &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
    455          ! 
     433      ! 
     434      zta = pzeta(ji,jj) 
     435      ! 
     436      zphi_m = ABS(1. - 15.*zta)**.25    !!Kansas unstable 
     437      ! 
     438      zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.)   & 
     439         & - 2.*ATAN(zphi_m) + 0.5*rpi 
     440      ! 
     441      zphi_c = ABS(1. - 10.15*zta)**.3333                   !!Convective 
     442      ! 
     443      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     444         &     - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     445      ! 
     446      zf = zta*zta 
     447      zf = zf/(1. + zf) 
     448      zc = MIN(50._wp, 0.35_wp*zta) 
     449      zstab = 0.5 + SIGN(0.5_wp, zta) 
     450      ! 
     451      psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 
     452         &                -   zstab     * ( 1. + 1.*zta     &                ! (zta > 0) 
     453         &                         + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 )   !     " 
     454      ! 
    456455      END_2D 
    457456      ! 
    … …  
    483482      ! 
    484483      DO_2D_11_11 
    485          ! 
    486          zta = pzeta(ji,jj) 
    487          ! 
    488          zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
    489          ! 
    490          zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
    491          ! 
    492          zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
    493          ! 
    494          zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
    495             &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
    496          ! 
    497          zf = zta*zta 
    498          zf = zf/(1. + zf) 
    499          zc = MIN(50._wp,0.35_wp*zta) 
    500          zstab = 0.5 + SIGN(0.5_wp, zta) 
    501          ! 
    502          psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
    503             &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
    504             &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
    505          ! 
     484      ! 
     485      zta = pzeta(ji,jj) 
     486      ! 
     487      zphi_h = (ABS(1. - 15.*zta))**.5  !! Kansas unstable   (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 
     488      ! 
     489      zpsi_k = 2.*LOG((1. + zphi_h)/2.) 
     490      ! 
     491      zphi_c = (ABS(1. - 34.15*zta))**.3333   !! Convective 
     492      ! 
     493      zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 
     494         &    -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 
     495      ! 
     496      zf = zta*zta 
     497      zf = zf/(1. + zf) 
     498      zc = MIN(50._wp,0.35_wp*zta) 
     499      zstab = 0.5 + SIGN(0.5_wp, zta) 
     500      ! 
     501      psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 
     502         &                -   zstab     * ( (ABS(1. + 2.*zta/3.))**1.5     & 
     503         &                           + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 
     504      ! 
    506505      END_2D 
    507506      ! 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r12377 r12695  
    9898      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    9999      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
    100       !!---------------------------------------------------------------------- 
     100      !!---------------------------------------------------------------------------------- 
    101101      !!                      ***  ROUTINE  turb_ecmwf  *** 
    102102      !! 
    … …  
    184184      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    185185      ! 
    186       REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
    187       REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
    188       REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     186      REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 
     187      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 
     188      REAL(wp), DIMENSION(jpi,jpj) :: znu_a         !: Nu_air, Viscosity of air 
    189189      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
    190190      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
    … …  
    196196      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
    197197      !!---------------------------------------------------------------------------------- 
    198  
    199198      IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
    200199 
    201       l_zt_equal_zu = .FALSE. 
    202       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     200      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    203201 
    204202      !! Initializations for cool skin and warm layer: 
    … …  
    413411      !!---------------------------------------------------------------------------------- 
    414412      DO_2D_11_11 
    415          ! 
    416          zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
    417          ! 
    418          ! Unstable (Paulson 1970): 
    419          !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    420          zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
    421          ztmp = 1._wp + SQRT(zx) 
    422          ztmp = ztmp*ztmp 
    423          psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
    424             &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
    425          ! 
    426          ! Unstable: 
    427          ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    428          psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
    429             &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
    430          ! 
    431          ! Combining: 
    432          stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    433          ! 
    434          psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
    435             &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
    436          ! 
     413      ! 
     414      zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 
     415      ! 
     416      ! Unstable (Paulson 1970): 
     417      !   eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     418      zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 
     419      ztmp = 1._wp + SQRT(zx) 
     420      ztmp = ztmp*ztmp 
     421      psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) )   & 
     422         &       -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 
     423      ! 
     424      ! Unstable: 
     425      ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
     426      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 
     427         &       - zzeta - 2._wp/3._wp*5._wp/0.35_wp 
     428      ! 
     429      ! Combining: 
     430      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     431      ! 
     432      psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 
     433         &                +      stab  * psi_stab      ! (zzeta > 0) Stable 
     434      ! 
    437435      END_2D 
    438436   END FUNCTION psi_m_ecmwf 
    … …  
    458456      ! 
    459457      DO_2D_11_11 
    460          ! 
    461          zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
    462          ! 
    463          zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
    464          !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
    465          ! Unstable (Paulson 1970) : 
    466          psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
    467          ! 
    468          ! Stable: 
    469          psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
    470             &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
    471          ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
    472          ! 
    473          stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
    474          ! 
    475          ! 
    476          psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
    477             &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
    478          ! 
     458      ! 
     459      zzeta = MIN(pzeta(ji,jj) , 5._wp)   ! Very stable conditions (L positif and big!): 
     460      ! 
     461      zx  = ABS(1._wp - 16._wp*zzeta)**.25        ! this is actually (1/phi_m)**2  !!! 
     462      !                                     ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 
     463      ! Unstable (Paulson 1970) : 
     464      psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx))   ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 
     465      ! 
     466      ! Stable: 
     467      psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 
     468         &       - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 
     469      ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 
     470      ! 
     471      stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 
     472      ! 
     473      ! 
     474      psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst &   ! (zzeta < 0) Unstable 
     475         &                +    stab    * psi_stab        ! (zzeta > 0) Stable 
     476      ! 
    479477      END_2D 
    480478   END FUNCTION psi_h_ecmwf 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk_algo_ncar.F90

    r12377 r12695  
    112112      REAL(wp), DIMENSION(jpi,jpj) ::   stab          ! stability test integer 
    113113      !!---------------------------------------------------------------------------------- 
    114       ! 
    115       l_zt_equal_zu = .FALSE. 
    116       IF( ABS(zu - zt) < 0.01_wp )   l_zt_equal_zu = .TRUE.    ! testing "zu == zt" is risky with double precision 
     114      l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 
    117115 
    118116      U_blk = MAX( 0.5_wp , U_zu )   !  relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s 
    … …  
    143141      ENDIF 
    144142 
    145       !! Initializing values at z_u with z_t values: 
    146       t_zu = t_zt   ;   q_zu = q_zt 
     143      !! First guess of temperature and humidity at height zu: 
     144      t_zu = MAX( t_zt ,  180._wp )   ! who knows what's given on masked-continental regions... 
     145      q_zu = MAX( q_zt , 1.e-6_wp )   !               " 
    147146 
    148147      !! ITERATION BLOCK 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbcblk_phy.F90

    r12377 r12695  
    520520         zCe = zz0*pqst(ji,jj)/zdq 
    521521 
    522          CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
    523             &              zCd, zCh, zCe,                                        & 
    524             &              pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                 & 
    525             &              pTau(ji,jj), zQsen, zQlat ) 
    526  
     522         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     523            &                    zCd, zCh, zCe,                                       & 
     524            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     525            &                    pTau(ji,jj), zQsen, zQlat ) 
     526          
    527527         zTs2  = pTs(ji,jj)*pTs(ji,jj) 
    528528         zQlw  = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux 
    … …  
    535535 
    536536 
    537    SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa,  & 
    538       &                          pCd, pCh, pCe,            & 
    539       &                          pwnd, pUb, pslp,          & 
    540       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
     537   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
     538      &                          pCd, pCh, pCe,           & 
     539      &                          pwnd, pUb, pslp,         & 
     540      &                          pTau, pQsen, pQlat,      & 
     541      &                          pEvap, prhoa, pfact_evap ) 
     542      !!---------------------------------------------------------------------------------- 
     543      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
     544      REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
     545      REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
     546      REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
     547      REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
     548      REAL(wp), INTENT(in)  :: pCd 
     549      REAL(wp), INTENT(in)  :: pCh 
     550      REAL(wp), INTENT(in)  :: pCe 
     551      REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
     552      REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
     553      REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
     554      !! 
     555      REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
     556      REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
     557      REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
     558      !! 
     559      REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
     560      REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
     561      REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     562      !! 
     563      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     564      INTEGER  :: jq 
     565      !!---------------------------------------------------------------------------------- 
     566      zfact_evap = 1._wp 
     567      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     568       
     569      !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
     570      ztaa = pTa ! first guess... 
     571      DO jq = 1, 4 
     572         zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )  !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 
     573         ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
     574      END DO 
     575      zrho = rho_air(ztaa, pqa, pslp) 
     576      zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
     577 
     578      zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
     579 
     580      pTau = zUrho * pCd * pwnd ! Wind stress module 
     581 
     582      zevap = zUrho * pCe * (pqa - pqs) 
     583      pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
     584      pQlat = L_vap(pTs) * zevap 
     585 
     586      IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap 
     587      IF( PRESENT(prhoa) ) prhoa = zrho 
     588 
     589   END SUBROUTINE BULK_FORMULA_SCLR 
     590 
     591   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 
     592      &                          pCd, pCh, pCe,           & 
     593      &                          pwnd, pUb, pslp,         & 
     594      &                          pTau, pQsen, pQlat,      &  
     595      &                          pEvap, prhoa, pfact_evap )       
    541596      !!---------------------------------------------------------------------------------- 
    542597      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    … …  
    558613      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    559614      REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    560       !! 
    561       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    562       INTEGER  :: ji, jj, jq     ! dummy loop indices 
    563       !!---------------------------------------------------------------------------------- 
    564       DO_2D_11_11 
    565  
    566          !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    567          ztaa = pTa(ji,jj) ! first guess... 
    568          DO jq = 1, 4 
    569             zgamma = gamma_moist( 0.5*(ztaa+pTs(ji,jj)) , pqa(ji,jj) ) 
    570             ztaa = pTa(ji,jj) - zgamma*pzu   ! Absolute temp. is slightly colder... 
    571          END DO 
    572          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)) 
    573          zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    574  
    575          zUrho = pUb(ji,jj)*MAX(zrho, 1._wp)     ! rho*U10 
    576  
    577          pTau(ji,jj) = zUrho * pCd(ji,jj) * pwnd(ji,jj) ! Wind stress module 
    578  
    579          zevap        = zUrho * pCe(ji,jj) * (pqa(ji,jj) - pqs(ji,jj)) 
    580          pQsen(ji,jj) = zUrho * pCh(ji,jj) * (pTa(ji,jj) - pTs(ji,jj)) * cp_air(pqa(ji,jj)) 
    581          pQlat(ji,jj) = L_vap(pTs(ji,jj)) * zevap 
    582  
    583          IF( PRESENT(pEvap) ) pEvap(ji,jj) = - zevap 
     615      REAL(wp),                     INTENT(in) , OPTIONAL :: pfact_evap  ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 
     616      !! 
     617      REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 
     618      INTEGER  :: ji, jj 
     619      !!---------------------------------------------------------------------------------- 
     620      zfact_evap = 1._wp 
     621      IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 
     622 
     623      DO_2D_11_11 
     624 
     625         CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     626            &                    pCd(ji,jj), pCh(ji,jj), pCe(ji,jj),                  & 
     627            &                    pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                & 
     628            &                    pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj),             & 
     629            &                    pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap       ) 
     630 
     631         IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 
    584632         IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 
    585  
     633    
    586634      END_2D 
    587635   END SUBROUTINE BULK_FORMULA_VCTR 
    588  
    589  
    590    SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
    591       &                          pCd, pCh, pCe,           & 
    592       &                          pwnd, pUb, pslp,         & 
    593       &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
    594       !!---------------------------------------------------------------------------------- 
    595       REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
    596       REAL(wp), INTENT(in)  :: pTs  ! water temperature at the air-sea interface [K] 
    597       REAL(wp), INTENT(in)  :: pqs  ! satur. spec. hum. at T=pTs   [kg/kg] 
    598       REAL(wp), INTENT(in)  :: pTa  ! potential air temperature at z=pzu [K] 
    599       REAL(wp), INTENT(in)  :: pqa  ! specific humidity at z=pzu [kg/kg] 
    600       REAL(wp), INTENT(in)  :: pCd 
    601       REAL(wp), INTENT(in)  :: pCh 
    602       REAL(wp), INTENT(in)  :: pCe 
    603       REAL(wp), INTENT(in)  :: pwnd ! wind speed module at z=pzu [m/s] 
    604       REAL(wp), INTENT(in)  :: pUb  ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 
    605       REAL(wp), INTENT(in)  :: pslp ! sea-level atmospheric pressure [Pa] 
    606       !! 
    607       REAL(wp), INTENT(out) :: pTau  ! module of the wind stress [N/m^2] 
    608       REAL(wp), INTENT(out) :: pQsen !  [W/m^2] 
    609       REAL(wp), INTENT(out) :: pQlat !  [W/m^2] 
    610       !! 
    611       REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 
    612       REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 
    613       !! 
    614       REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 
    615       INTEGER  :: jq 
    616       !!---------------------------------------------------------------------------------- 
    617  
    618       !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 
    619       ztaa = pTa ! first guess... 
    620       DO jq = 1, 4 
    621          zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa ) 
    622          ztaa = pTa - zgamma*pzu   ! Absolute temp. is slightly colder... 
    623       END DO 
    624       zrho = rho_air(ztaa, pqa, pslp) 
    625       zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 
    626  
    627       zUrho = pUb*MAX(zrho, 1._wp)     ! rho*U10 
    628  
    629       pTau = zUrho * pCd * pwnd ! Wind stress module 
    630  
    631       zevap = zUrho * pCe * (pqa - pqs) 
    632       pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 
    633       pQlat = L_vap(pTs) * zevap 
    634  
    635       IF( PRESENT(pEvap) ) pEvap = - zevap 
    636       IF( PRESENT(prhoa) ) prhoa = zrho 
    637  
    638    END SUBROUTINE BULK_FORMULA_SCLR 
    639  
    640  
    641636 
    642637 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/SBC/sbccpl.F90

    r12489 r12695  
    11151115         IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 )   & 
    11161116            &   CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    1117          ncpl_qsr_freq = 86400 / ncpl_qsr_freq   ! used by top 
     1117 
     1118         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
     1119          
    11181120      ENDIF 
    11191121      ! 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/STO/storng.F90

    r12377 r12695  
    5050 
    5151   ! Parameters to generate real random variates 
    52    REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0  ! +1 
    5352   REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 
    5453 
    … …  
    275274      REAL(KIND=wp) :: uran 
    276275 
    277       uran = half * ( one + REAL(kiss(),wp) / huge64 ) 
     276      uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) ) 
    278277 
    279278   END SUBROUTINE kiss_uniform 
    … …  
    298297         rsq = two 
    299298         DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) ) 
    300             u1 = REAL(kiss(),wp) / huge64 
    301             u2 = REAL(kiss(),wp) / huge64 
     299            u1 = REAL(kiss(),wp) / HUGE(1._wp) 
     300            u2 = REAL(kiss(),wp) / HUGE(1._wp) 
    302301            rsq = u1*u1 + u2*u2 
    303302         ENDDO 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/nemogcm.F90

    r12489 r12695  
    8484#endif 
    8585   ! 
     86   USE in_out_manager ! I/O manager 
    8687   USE lib_mpp        ! distributed memory computing 
    8788   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    … …  
    317318      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    318319      ! open /dev/null file to be able to supress output write easily 
     320      IF( Agrif_Root() ) THEN 
    319321                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    320       ! 
     322#ifdef key_agrif 
     323      ELSE 
     324                  numnul = Agrif_Parent(numnul)    
     325#endif 
     326      ENDIF 
    321327      !                             !--------------------! 
    322328      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp 

  • NEMO/branches/2020/ticket2406_trunk/src/OCE/step.F90

    r12489 r12695  
    8787      !! --------------------------------------------------------------------- 
    8888#if defined key_agrif 
     89      IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step  
    8990      kstp = nit000 + Agrif_Nb_Step() 
    9091      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    … …  
    309310#if defined key_agrif 
    310311      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    311       ! AGRIF 
     312      ! AGRIF recursive integration 
    312313      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    313314                         Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs      ! agrif_oce module copies of time level indices 
    314315                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
    315  
    316                          IF( Agrif_NbStepint() == 0 ) THEN 
    317                             CALL Agrif_update_all( )                  ! Update all components 
    318                          ENDIF 
     316#endif 
     317      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     318      ! Control 
     319      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     320                         CALL stp_ctl      ( kstp, Nbb, Nnn, indic ) 
     321#if defined key_agrif 
     322      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     323      ! AGRIF update 
     324      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     325      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN 
     326                         CALL Agrif_update_all( )                  ! Update all components 
     327      ENDIF 
    319328#endif 
    320329      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    321330 
    322331      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    323       ! Control 
    324       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    325                          CALL stp_ctl      ( kstp, Nbb, Nnn, indic ) 
    326                           
     332      ! File manipulation at the end of the first time step 
     333      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
    327334      IF( kstp == nit000 ) THEN                          ! 1st time step only 
    328335                                        CALL iom_close( numror )   ! close input  ocean restart file 
    … …  
    338345      ! 
    339346#if defined key_iomput 
     347      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     348      ! Finalize contextes if end of simulation or error detected 
     349      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
    340350      IF( kstp == nitend .OR. indic < 0 ) THEN  
    341351                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
    342                       IF(lrxios) CALL iom_context_finalize(      crxios_context          ) 
     352         IF( lrxios ) CALL iom_context_finalize(      crxios_context         ) 
    343353         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
    344354      ENDIF 

  • NEMO/branches/2020/ticket2406_trunk/src/OFF/nemogcm.F90

    r12377 r12695  
    209209      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    210210      ! open /dev/null file to be able to supress output write easily 
     211      IF( Agrif_Root() ) THEN 
    211212                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     213#ifdef key_agrif 
     214      ELSE 
     215                  numnul = Agrif_Parent(numnul)    
     216#endif 
     217      ENDIF 
    212218      ! 
    213219      !                             !--------------------! 

  • NEMO/branches/2020/ticket2406_trunk/src/SAO/nemogcm.F90

    r12377 r12695  
    2929   USE sao_intp 
    3030   ! 
     31   USE in_out_manager ! I/O manager 
    3132   USE lib_mpp        ! distributed memory computing 
    3233   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    … …  
    139140      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    140141      ! open /dev/null file to be able to supress output write easily 
     142      IF( Agrif_Root() ) THEN 
    141143                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     144#ifdef key_agrif 
     145      ELSE 
     146                  numnul = Agrif_Parent(numnul)    
     147#endif 
     148      ENDIF 
    142149      ! 
    143150      !                             !--------------------! 

  • NEMO/branches/2020/ticket2406_trunk/src/SAS/diawri.F90

    r12489 r12695  
    9999      ! Output the initial state and forcings 
    100100      IF( ninist == 1 ) THEN 
    101          CALL dia_wri_state( 'output.init', Kmm ) 
     101         CALL dia_wri_state( Kmm, 'output.init' ) 
    102102         ninist = 0 
    103103      ENDIF 
    … …  
    126126   END FUNCTION dia_wri_alloc_abl 
    127127   
    128    SUBROUTINE dia_wri( kt ) 
     128   SUBROUTINE dia_wri( kt, Kmm ) 
    129129      !!--------------------------------------------------------------------- 
    130130      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    140140      !! 
    141141      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     142      INTEGER, INTENT( in ) ::   Kmm  ! ocean time level index 
    142143      !! 
    143144      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout 
    … …  
    154155      ! Output the initial state and forcings 
    155156      IF( ninist == 1 ) THEN                        
    156          CALL dia_wri_state( 'output.init' ) 
     157         CALL dia_wri_state( Kmm, 'output.init' ) 
    157158         ninist = 0 
    158159      ENDIF 
    … …  
    257258         IF( ln_abl ) THEN  
    258259         ! Define the ABL grid FILE ( nid_A ) 
    259             CALL dia_nam( clhstnam, nwrite, 'grid_ABL' ) 
     260            CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 
    260261            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
    261262            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    … …  
    414415#endif 
    415416 
    416    SUBROUTINE dia_wri_state( cdfile_name, Kmm ) 
     417   SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 
    417418      !!--------------------------------------------------------------------- 
    418419      !!                 ***  ROUTINE dia_wri_state  *** 
    … …  
    427428      !!      File 'output.abort.nc' is created in case of abnormal job end 
    428429      !!---------------------------------------------------------------------- 
     430      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    429431      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
    430       INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    431432      !! 
    432433      INTEGER :: inum 
    … …  
    437438      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created ' 
    438439      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '...nc' 
    439  
    440 #if defined key_si3 
    441      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
    442 #else 
    443      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
    444 #endif 
    445  
     440      ! 
     441      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 
     442      ! 
    446443      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
    447444      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
    … …  
    456453      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
    457454      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
    458   
     455      ! 
     456      CALL iom_close( inum ) 
     457      ! 
    459458#if defined key_si3 
    460459      IF( nn_ice == 2 ) THEN   ! condition needed in case agrif + ice-model but no-ice in child grid 
     460         CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    461461         CALL ice_wri_state( inum ) 
    462       ENDIF 
    463 #endif 
    464       ! 
    465       CALL iom_close( inum ) 
    466       ! 
     462         CALL iom_close( inum ) 
     463      ENDIF 
     464#endif 
     465 
    467466   END SUBROUTINE dia_wri_state 
    468467 

  • NEMO/branches/2020/ticket2406_trunk/src/SAS/nemogcm.F90

    r12489 r12695  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE in_out_manager ! I/O manager 
    3738   USE lib_mpp        ! distributed memory computing 
    3839   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    … …  
    256257      ENDIF 
    257258      ! open /dev/null file to be able to supress output write easily 
     259      IF( Agrif_Root() ) THEN 
    258260                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     261#ifdef key_agrif 
     262      ELSE 
     263                  numnul = Agrif_Parent(numnul)    
     264#endif 
     265      ENDIF 
    259266      ! 
    260267      !                             !--------------------! 

  • NEMO/branches/2020/ticket2406_trunk/src/SAS/sbcssm.F90

    r12377 r12695  
    2626   USE lib_mpp        ! distributed memory computing library 
    2727   USE prtctl         ! print control 
    28    USE fldread        ! read input fields  
     28   USE fldread        ! read input fields 
    2929   USE timing         ! Timing 
    3030 
    … …  
    3838   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D 
    3939   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not 
    40     
     40 
    4141   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion 
    4242   LOGICAL            ::   l_initdone = .false. 
    … …  
    6969      !!               for an off-line simulation using surface processes only 
    7070      !! 
    71       !! ** Method : calculates the position of data  
     71      !! ** Method : calculates the position of data 
    7272      !!             - interpolates data if needed 
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7575      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    76                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     76      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7777      ! 
    7878      INTEGER  ::   ji, jj     ! dummy loop indices 
    … …  
    8282      ! 
    8383      IF( ln_timing )   CALL timing_start( 'sbc_ssm') 
    84       
     84 
    8585      IF ( l_sasread ) THEN 
    8686         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    8787         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    88          !  
     88         ! 
    8989         IF( ln_3d_uve ) THEN 
    9090            IF( .NOT. ln_linssh ) THEN 
    91                e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     91               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    9292            ELSE 
    9393               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    9494            ENDIF 
    9595            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    96             ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     96            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    9797         ELSE 
    9898            IF( .NOT. ln_linssh ) THEN 
    99                e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor  
     99               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 
    100100            ELSE 
    101101               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor 
    102102            ENDIF 
    103103            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    104             ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     104            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity 
    105105         ENDIF 
    106106         ! 
    … …  
    123123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    124124      ENDIF 
    125        
     125 
    126126      IF ( nn_ice == 1 ) THEN 
    127127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
    … …  
    132132      uu (:,:,1,Kbb) = ssu_m(:,:) 
    133133      vv (:,:,1,Kbb) = ssv_m(:,:) 
    134   
     134 
    135135      IF(sn_cfctl%l_prtctl) THEN            ! print control 
    136136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   ) 
    … …  
    162162      !!                  ***  ROUTINE sbc_ssm_init  *** 
    163163      !! 
    164       !! ** Purpose :   Initialisation of sea surface mean data      
    165       !!---------------------------------------------------------------------- 
    166       INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices  
    167                           ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
     164      !! ** Purpose :   Initialisation of sea surface mean data 
     165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     167      ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    168168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    169169      INTEGER  :: ifpr                               ! dummy loop indice 
    … …  
    195195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 
    196196      IF(lwm) WRITE ( numond, namsbc_sas ) 
    197       !            
     197      ! 
    198198      IF(lwp) THEN                              ! Control print 
    199199         WRITE(numout,*) '   Namelist namsbc_sas' 
    200          WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread  
     200         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
    201201         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
    202202         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    … …  
    226226         ln_closea = .false. 
    227227      ENDIF 
    228        
    229       !                   
     228 
     229      ! 
    230230      IF( l_sasread ) THEN                       ! store namelist information in an array 
    231          !  
     231         ! 
    232232         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    233233         !! when we have other 3d arrays that we need to read in 
    … …  
    275275         ENDIF 
    276276         ! 
    277          ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
     277         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false. 
    278278         IF( nfld_3d > 0 ) THEN 
    279279            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
    … …  
    282282            ENDIF 
    283283            DO ifpr = 1, nfld_3d 
    284                                             ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
     284               ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 ) 
    285285               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 ) 
    286286               IF( ierr0 + ierr1 > 0 ) THEN 
    … …  
    298298            ENDIF 
    299299            DO ifpr = 1, nfld_2d 
    300                                             ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     300               ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
    301301               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
    302302               IF( ierr0 + ierr1 > 0 ) THEN 

  • NEMO/branches/2020/ticket2406_trunk/src/SAS/step.F90

    r12377 r12695  
    7878 
    7979#if defined key_agrif 
     80      IF( nstop > 0 ) return   ! avoid to go further if an error was detected during previous time step  
    8081      kstp = nit000 + Agrif_Nb_Step() 
    8182      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    … …  
    109110#if defined key_agrif 
    110111      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    111       ! AGRIF 
     112      ! AGRIF recursive integration 
    112113      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    113114                             CALL Agrif_Integrate_ChildGrids( stp )   
    114  
    115       IF( Agrif_NbStepint() == 0 ) THEN               ! AGRIF Update from zoom N to zoom 1 then to Parent  
    116 #if defined key_si3 
    117                              CALL Agrif_Update_ice( )   ! update sea-ice 
    118 #endif 
    119       ENDIF 
    120115#endif 
    121116                              
    … …  
    126121      IF( indic < 0  )  THEN 
    127122                             CALL ctl_stop( 'step: indic < 0' ) 
    128                              CALL dia_wri_state( 'output.abort', Nnn ) 
     123                             CALL dia_wri_state( Nnn, 'output.abort' ) 
    129124      ENDIF 
    130       IF( kstp == nit000   ) CALL iom_close( numror )           ! close input  ocean restart file 
     125#if defined key_agrif 
     126      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     127      ! AGRIF update 
     128      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     129      IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN                       ! AGRIF Update from zoom N to zoom 1 then to Parent  
     130#if defined key_si3 
     131                             CALL Agrif_Update_ice( )   ! update sea-ice 
     132#endif 
     133      ENDIF 
     134#endif 
     135      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     136      ! File manipulation at the end of the first time step 
     137      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          
     138      IF( kstp == nit000   ) CALL iom_close( numror )                          ! close input  ocean restart file 
    131139       
    132140      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

  • NEMO/branches/2020/ticket2406_trunk/src/TOP/PISCES/SED/sedrst.F90

    r12489 r12695  
    8080         IF(lwp) WRITE(numsed,*) & 
    8181             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname 
    82          CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed ) 
     82         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 
    8383         lrst_sed = .TRUE. 
    8484      ENDIF 

  • NEMO/branches/2020/ticket2406_trunk/src/TOP/trcstp.F90

    r12489 r12695  
    142142      ! 
    143143      ! Define logical parameter ton control dirunal cycle in TOP 
    144       l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    145       l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline 
     144      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 ) 
     145      l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 
     146      ! 
    146147      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
    147148         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 

  • NEMO/branches/2020/ticket2406_trunk/tests/BENCH/MY_SRC/usrdef_nam.F90

    r12377 r12695  
    5555      !                              !!* nammpp namelist *!! 
    5656      INTEGER          ::   jpni, jpnj 
    57       LOGICAL          ::   ln_nnogather 
     57      LOGICAL          ::   ln_nnogather, ln_listonly 
    5858      !! 
    5959      NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, nn_perio 
    60       NAMELIST/nammpp/ jpni, jpnj, ln_nnogather 
     60      NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly 
    6161      !!----------------------------------------------------------------------      
    6262      ! 

  • NEMO/branches/2020/ticket2406_trunk/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90

    r12377 r12695  
    8989         kpj = nbcellsy + 2 + 2*nbghostcells 
    9090      ENDIF 
    91       kpk = 1 
     91      kpk = 2 
    9292      ! 
    9393!!      zlx = (kpi-2)*rn_dx*1.e-3 

  • NEMO/branches/2020/ticket2406_trunk/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90

    r12377 r12695  
    8989      !                       !==  z-coordinate  ==!   (step-like topography) 
    9090      !                                !* bottom ocean compute from the depth of grid-points 
    91       jpkm1 = jpk 
     91      jpkm1 = jpk-1 
    9292      k_bot(:,:) = 1    ! here use k_top as a land mask 
    9393      !                                !* horizontally uniform coordinate (reference z-co everywhere) 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/launch_sasf.sh

    r11996 r12695  
    22 
    33# NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 
    4 NEMO_DIR="${HOME}/NEMO/NEMOvdev_r11085_ASINTER-05_Brodeau_Advanced_Bulk" 
     4NEMO_DIR=`pwd | sed -e "s|/tests/STATION_ASF/EXPREF||g"` 
     5 
     6echo "Using NEMO_DIR=${NEMO_DIR}" 
     7 
     8# what directory inside "tests" actually contains the compiled test-case? 
     9TC_DIR="STATION_ASF2" 
     10 
     11# => so the executable to use is: 
     12NEMO_EXE="${NEMO_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 
    513 
    614# Directory where to run the simulation: 
    … …  
    2432mkdir -p ${WORK_DIR} 
    2533 
    26 NEMO_EXE="${NEMO_DIR}/tests/STATION_ASF/BLD/bin/nemo.exe" 
     34 
    2735if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 
    2836 
    … …  
    4048rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/ 
    4149 
    42 for CASE in "ECMWF-noskin" "COARE3p6-noskin" "ECMWF" "COARE3p6" "NCAR"; do 
     50for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 
    4351 
    4452    echo ; echo 
    … …  
    5664    echo 
    5765    echo "Launching NEMO !" 
    58     ./nemo.exe 1> out_nemo.out 2>err_nemo.err 
     66    ./nemo.exe 1>out_nemo.out 2>err_nemo.err 
    5967    echo "Done!" 
    6068    echo 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg

    r12489 r12695  
    3333   nn_time0    =       0   !  initial time of day in hhmm 
    3434   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    35    ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    36       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     35   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     36      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    3737      nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T 
    3838      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg

    r12489 r12695  
    3333   nn_time0    =       0   !  initial time of day in hhmm 
    3434   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    35    ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    36       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     35   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     36      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    3737      nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T 
    3838      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg

    r12489 r12695  
    3333   nn_time0    =       0   !  initial time of day in hhmm 
    3434   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    35    ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    36       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     35   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     36      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    3737      nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T 
    3838      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg

    r12489 r12695  
    3333   nn_time0    =       0   !  initial time of day in hhmm 
    3434   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    35    ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    36       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     35   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     36      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    3737      nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T 
    3838      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/namelist_ncar_cfg

    r12489 r12695  
    3333   nn_time0    =       0   !  initial time of day in hhmm 
    3434   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    35    ln_rstart   =  .false.   !  start from rest (F) or from a restart file (T) 
    36       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
     35   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     36      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
    3737      nn_rstctl   = 2      !  restart control ==> activated only if ln_rstart=T 
    3838      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/EXPREF/plot_station_asf.py

    r12031 r12695  
    5353L_VARL  = [ r'$Q_{lat}$', r'$Q_{sens}$' , r'$Q_{net}$' , r'$Q_{lw}$' , r'$|\tau|$' , r'$\Delta T_{skin}$' ] ; # name of variable in latex mode 
    5454L_VUNT  = [ r'$W/m^2$'  , r'$W/m^2$'    , r'$W/m^2$'   , r'$W/m^2$'  , r'$N/m^2$'  ,      'K'             ] 
    55 L_VMAX  = [     75.     ,     75.       ,    800.      ,     25.     ,    1.2      ,      -0.7            ] 
    56 L_VMIN  = [   -250.     ,   -125.       ,   -400.      ,   -150.     ,    0.       ,       0.7            ] 
     55L_VMAX  = [     75.     ,     75.       ,    800.      ,     25.     ,    1.2      ,       0.7            ] 
     56L_VMIN  = [   -250.     ,   -125.       ,   -400.      ,   -150.     ,    0.       ,      -0.7            ] 
    5757L_ANOM  = [   True      ,    True       ,    True      ,    True     ,   True      ,      False           ] 
    5858 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/diawri.F90

    r12489 r12695  
    3535   USE iom            ! 
    3636   USE ioipsl         ! 
     37 
    3738#if defined key_si3 
    3839   USE ice 
    … …  
    5657 
    5758   !!---------------------------------------------------------------------- 
    58    !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    59    !! $Id: diawri.F90 10425 2018-12-19 21:54:16Z smasson $ 
     59   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     60   !! $Id: diawri.F90 12493 2020-03-02 07:56:31Z smasson $ 
    6061   !! Software governed by the CeCILL license (see ./LICENSE) 
    6162   !!---------------------------------------------------------------------- 
    … …  
    114115      INTEGER, DIMENSION(2) :: ierr 
    115116      !!---------------------------------------------------------------------- 
    116       ierr = 0 
    117       ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    118          &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
    119          &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
    120       ! 
    121       dia_wri_alloc = MAXVAL(ierr) 
    122       CALL mpp_sum( 'diawri', dia_wri_alloc ) 
     117      IF( nn_write == -1 ) THEN 
     118         dia_wri_alloc = 0 
     119      ELSE 
     120         ierr = 0 
     121         ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
     122            &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
     123            &      ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 
     124         ! 
     125         dia_wri_alloc = MAXVAL(ierr) 
     126         CALL mpp_sum( 'diawri', dia_wri_alloc ) 
     127         ! 
     128      ENDIF 
    123129      ! 
    124130   END FUNCTION dia_wri_alloc 
    … …  
    374380      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm)                )    ! now i-velocity 
    375381      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm)                )    ! now j-velocity 
    376          CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity 
     382      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww             )    ! now k-velocity 
    377383      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
    378384      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r12254 r12695  
    22   !!====================================================================== 
    33   !!                       ***  MODULE nemogcm   *** 
    4    !! StandAlone Surface module : surface fluxes 
     4   !!                      STATION_ASF (SAS meets C1D) 
    55   !!====================================================================== 
    66   !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code 
    … …  
    1919   !!---------------------------------------------------------------------- 
    2020   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
    21    USE sbc_oce        ! surface boundary condition: ocean #LB: rm? 
    2221   USE phycst         ! physical constant                  (par_cst routine) 
    2322   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    2423   USE closea         ! treatment of closed seas (for ln_closea) 
    2524   USE usrdef_nam     ! user defined configuration 
     25   USE istate         ! initial state setting          (istate_init routine) 
    2626   USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 
    2727   USE daymod         ! calendar 
    2828   USE restart        ! open  restart file 
    29    !LB:USE step           ! NEMO time-stepping                 (stp     routine) 
    3029   USE c1d            ! 1D configuration 
    3130   USE step_c1d       ! Time stepping loop for the 1D configuration 
    32    USE sbcssm         ! 
    3331   ! 
     32   USE in_out_manager ! I/O manager 
    3433   USE lib_mpp        ! distributed memory computing 
    3534   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    … …  
    4948   !!---------------------------------------------------------------------- 
    5049   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    51    !! $Id: nemogcm.F90 11536 2019-09-11 13:54:18Z smasson $ 
     50   !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $ 
    5251   !! Software governed by the CeCILL license (see ./LICENSE) 
    5352   !!---------------------------------------------------------------------- 
    … …  
    8483      !                            !==   time stepping   ==! 
    8584      !                            !-----------------------! 
     85      ! 
     86      !                                               !== set the model time-step  ==! 
     87      ! 
    8688      istp = nit000 
    8789      ! 
    … …  
    106108      ! 
    107109#if defined key_iomput 
    108       CALL xios_finalize  ! end mpp communications with xios 
     110                                    CALL xios_finalize  ! end mpp communications with xios 
    109111#else 
    110       IF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
    111       ENDIF 
     112      IF( lk_mpp )                  CALL mppstop      ! end mpp communications 
    112113#endif 
    113114      ! 
    … …  
    161162      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    162163      ! open reference and configuration namelist files 
    163       CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
    164       CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
     164                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
     165                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
    165166      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    166167      ! open /dev/null file to be able to supress output write easily 
    167       CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     168      IF( Agrif_Root() ) THEN 
     169                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     170#ifdef key_agrif 
     171      ELSE 
     172                  numnul = Agrif_Parent(numnul)    
     173#endif 
     174      ENDIF 
    168175      ! 
    169176      !                             !--------------------! 
    … …  
    235242903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    236243      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    237 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 
     244904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
    238245      ! 
    239246      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    … …  
    266273      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
    267274      ! 
    268       CALL     phy_cst         ! Physical constants 
    269       CALL     eos_init        ! Equation of state 
     275                           CALL     phy_cst         ! Physical constants 
     276                           CALL     eos_init        ! Equation of state 
    270277      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    271       CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
     278                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
    272279      IF( sn_cfctl%l_prtctl )   & 
    273280         &                 CALL prt_ctl_init        ! Print control 
    274  
    275       IF( ln_rstart ) THEN                    ! Restart from a file                                                                                  
    276          !                                    ! -------------------                                                                                  
    277          CALL rst_read( Nbb, Nnn )            ! Read the restart file                                                                                
    278          CALL day_init                        ! model calendar (using both namelist and restart infos)                                               
    279          !                                                                                                                                           
    280       ELSE                                    ! Start from rest                                                                                      
    281          !                                    ! ---------------                                                                                      
    282          numror = 0                           ! define numror = 0 -> no restart file to read                                                         
    283          neuler = 0                           ! Set time-step indicator at nit000 (euler forward)                                                    
    284          CALL day_init                        ! model calendar (using both namelist and restart infos)                                               
    285       ENDIF 
    286       ! 
    287  
    288       !                                      ! external forcing 
    289       CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
     281      ! 
     282       
     283                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
     284 
     285      !                                      ! external forcing  
     286                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    290287 
    291288      ! 
    … …  
    321318         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
    322319         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    323          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
    324          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
    325          WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
    326          WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
     320         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
     321         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
     322         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
     323         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    327324         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    328325         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    … …  
    439436      !!---------------------------------------------------------------------- 
    440437      ! 
    441       ierr =        oce_alloc    ()    ! ocean 
     438      ierr =        oce_alloc    ()    ! ocean  
    442439      ierr = ierr + dia_wri_alloc() 
    443440      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    … …  
    448445   END SUBROUTINE nemo_alloc 
    449446 
    450  
     447    
    451448   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
    452449      !!---------------------------------------------------------------------- 
    … …  
    479476   !!====================================================================== 
    480477END MODULE nemogcm 
     478 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/sbcssm.F90

    r12249 r12695  
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    56    !! $Id: sbcssm.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
     56   !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $ 
    5757   !! Software governed by the CeCILL license (see ./LICENSE) 
    5858   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90

    r11930 r12695  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp, njmpp        ! ocean space and time domain 
     16   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    1717   USE c1d      ,  ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 
    1818   USE par_oce        ! ocean space and time domain 
    … …  
    3030   !!---------------------------------------------------------------------- 
    3131   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    32    !! $Id: usrdef_hgr.F90 10072 2018-08-28 15:21:50Z nicolasmartin $ 
     32   !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $  
    3333   !! Software governed by the CeCILL license (see ./LICENSE) 
    3434   !!---------------------------------------------------------------------- 
    … …  
    5454      !! 
    5555      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees)  
    56       !!              - define coriolis parameter at f-point if the domain in not on the sphere 
     56      !!              - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 
    5757      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 
    5858      !!              - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/usrdef_nam.F90

    r12249 r12695  
    88   !!====================================================================== 
    99   !! History :  4.0  ! 2016-03  (S. Flavoni, G. Madec)  Original code 
    10    !! History :  4.x  ! 2019-10  (L. Brodeau) for STATION_ASF (C1D meets SAS) 
     10   !!            4.x  ! 2019-10  (L. Brodeau) for STATION_ASF (C1D meets SAS) 
    1111   !!---------------------------------------------------------------------- 
    1212 
    … …  
    1515   !!   usr_def_hgr   : initialize the horizontal mesh  
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce  , ONLY: nimpp, njmpp             ! ocean space and time domain 
    18    USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
     17   USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
     18!!!   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1919   USE par_oce        ! ocean space and time domain 
    2020   USE phycst         ! physical constants 
    … …  
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    35    !! $Id: usrdef_nam.F90 11536 2019-09-11 13:54:18Z smasson $  
     35   !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $  
    3636   !! Software governed by the CeCILL license (see ./LICENSE) 
    3737   !!---------------------------------------------------------------------- 
    … …  
    6868      kk_cfg = 0 
    6969 
    70       ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 75 or vertical levels 
     70      ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 2 or vertical levels 
    7171      kpi = 3 
    7272      kpj = 3 
    73       kpk = 1 
     73      kpk = 2    ! 2, rather than 1, because 1 would cause some issues... like overflow in array boundary indexes, etc... 
    7474      ! 
    7575      !                             ! Set the lateral boundary condition of the global domain 

  • NEMO/branches/2020/ticket2406_trunk/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90

    r12038 r12695  
    11MODULE usrdef_zgr 
    22   !!====================================================================== 
    3    !!                     ***  MODULE usrdef_zgr  *** 
     3   !!                       ***  MODULE usrdef_zgr  *** 
    44   !! 
    55   !!                       ===  STATION_ASF case  === 
    66   !! 
    7    !! user defined : vertical coordinate system of a user configuration 
     7   !! User defined : vertical coordinate system of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0  ! 2019-10  (L. Brodeau)  Original code 
     9   !! History :  4.0  ! 2016-06  (G. Madec)  Original code 
     10   !!            4.x  ! 2019-10  (L. Brodeau) Station ASF 
    1011   !!---------------------------------------------------------------------- 
    1112 
    1213   !!---------------------------------------------------------------------- 
    13    !!   usr_def_zgr   : user defined vertical coordinate system (required) 
     14   !!   usr_def_zgr   : user defined vertical coordinate system 
     15   !!      zgr_z      : reference 1D z-coordinate  
     16   !!      zgr_top_bot: ocean top and bottom level indices 
     17   !!      zgr_zco    : 3D verticl coordinate in pure z-coordinate case 
    1418   !!--------------------------------------------------------------------- 
    1519   USE oce            ! ocean variables 
    16    !USE dom_oce        ! ocean domain 
    17    !USE depth_e3       ! depth <=> e3 
    1820   USE usrdef_nam     ! User defined : namelist variables 
    1921   ! 
    … …  
    2123   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2224   USE lib_mpp        ! distributed memory computing library 
    23    USE timing         ! Timing 
    2425 
    2526   IMPLICIT NONE 
    2627   PRIVATE 
    2728 
    28    PUBLIC   usr_def_zgr   ! called by domzgr.F90 
     29   PUBLIC   usr_def_zgr        ! called by domzgr.F90 
    2930 
    3031   !!---------------------------------------------------------------------- 
    3132   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    32    !! $Id: usrdef_zgr.F90 10072 2018-08-28 15:21:50Z nicolasmartin $ 
     33   !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $ 
    3334   !! Software governed by the CeCILL license (see ./LICENSE) 
    3435   !!---------------------------------------------------------------------- 
    … …  
    4748      !! 
    4849      !!---------------------------------------------------------------------- 
    49       LOGICAL                   , INTENT(  out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags ( read in namusr_def ) 
    50       LOGICAL                   , INTENT(  out) ::   ld_isfcav                   ! under iceshelf cavity flag 
    51       REAL(wp), DIMENSION(:)    , INTENT(  out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m] 
    52       REAL(wp), DIMENSION(:)    , INTENT(  out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m] 
    53       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept, pdepw                ! grid-point depth        [m] 
    54       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m] 
    55       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors 
    56       INTEGER , DIMENSION(:,:)  , INTENT(  out) ::   k_top, k_bot                ! first & last ocean level 
     50      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags 
     51      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag 
     52      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth     [m] 
     53      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D grid-point depth     [m] 
     54      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth        [m] 
     55      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors  [m] 
     56      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         ! i-scale factors  
     57      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top, k_bot                ! first & last ocean level 
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    6162      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    6263      ! 
    63  
     64      ! 
     65      ! type of vertical coordinate 
     66      ! --------------------------- 
    6467      ld_zco    = .TRUE.         ! z-coordinate without ocean cavities 
    6568      ld_zps    = .FALSE. 
    6669      ld_sco    = .FALSE. 
    6770      ld_isfcav = .FALSE. 
    68        
     71 
     72      !! 1st level (the only one that matters) 
    6973      pdept_1d(1) = rn_dept1 ! depth (m) at which the SST is taken/measured == depth of first T point! 
    7074      pdepw_1d(1) = 0._wp 
    … …  
    7276      pe3w_1d(1)  = rn_dept1 ! LB??? 
    7377 
    74       pdept(:,:,:) = rn_dept1 
    75       pdepw(:,:,:) = 0._wp 
    76       pe3t(:,:,:) = 2._wp*rn_dept1 
    77       pe3u(:,:,:) = 2._wp*rn_dept1 
    78       pe3v(:,:,:) = 2._wp*rn_dept1 
    79       pe3f(:,:,:) = 2._wp*rn_dept1 
    80       pe3w(:,:,:)  = rn_dept1  ! LB??? 
    81       pe3uw(:,:,:) = rn_dept1  ! LB??? 
    82       pe3vw(:,:,:) = rn_dept1  ! LB??? 
     78      pdept(:,:,1) = rn_dept1 
     79      pdepw(:,:,1) = 0._wp 
     80      pe3t(:,:,1) = 2._wp*rn_dept1 
     81      pe3u(:,:,1) = 2._wp*rn_dept1 
     82      pe3v(:,:,1) = 2._wp*rn_dept1 
     83      pe3f(:,:,1) = 2._wp*rn_dept1 
     84      pe3w(:,:,1)  = rn_dept1  ! LB??? 
     85      pe3uw(:,:,1) = rn_dept1  ! LB??? 
     86      pe3vw(:,:,1) = rn_dept1  ! LB??? 
     87       
     88      !! 2nd level, technically useless (only for the sake of code stability) 
     89      pdept_1d(2) = 3._wp*rn_dept1 
     90      pdepw_1d(2) = 2._wp*rn_dept1 
     91      pe3t_1d(2)  = 2._wp*rn_dept1 
     92      pe3w_1d(2)  = 2._wp*rn_dept1 
     93 
     94      pdept(:,:,2) = 3._wp*rn_dept1 
     95      pdepw(:,:,2) = 2._wp*rn_dept1 
     96      pe3t(:,:,2) = 2._wp*rn_dept1 
     97      pe3u(:,:,2) = 2._wp*rn_dept1 
     98      pe3v(:,:,2) = 2._wp*rn_dept1 
     99      pe3f(:,:,2) = 2._wp*rn_dept1 
     100      pe3w(:,:,2)  = 2._wp*rn_dept1 
     101      pe3uw(:,:,2) = 2._wp*rn_dept1 
     102      pe3vw(:,:,2) = 2._wp*rn_dept1 
     103 
    83104      k_top = 1 
    84105      k_bot = 1 
    85       ! 
     106 
    86107   END SUBROUTINE usr_def_zgr 
    87108   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.