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 13121 for NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src – NEMO

Ignore:
Timestamp:
2020-06-17T13:01:47+02:00 (4 years ago)
Author:
acc
Message:

2020/dev_r12953_ENHANCE-10_acc_fix_traqsr. Merge in trunk changes from 12953 to current HEAD (13115). Fully SETTE tested

Location:
NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src
Files:
23 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DIA/diaar5.F90

    r12630 r13121  
    7777      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 2D workspace  
    7878      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: zpe, z2d                   ! 2D workspace  
    79       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , zrhop, ztpot   ! 3D workspace 
     79      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   :: zrhd , ztpot               ! 3D workspace 
    8080      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn                       ! 4D workspace 
    8181 
     
    8787      IF( l_ar5 ) THEN  
    8888         ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 
    89          ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 
     89         ALLOCATE( zrhd(jpi,jpj,jpk) ) 
    9090         ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 
    9191         zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 
     
    155155       
    156156         !                                         ! steric sea surface height 
    157          CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) )                 ! now in situ and potential density 
    158          zrhop(:,:,jpk) = 0._wp 
    159          CALL iom_put( 'rhop', zrhop ) 
    160          ! 
    161157         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    162158         DO jk = 1, jpkm1 
    163             zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 
     159            zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 
    164160         END DO 
    165161         IF( ln_linssh ) THEN 
     
    168164                  DO jj = 1,jpj 
    169165                     iks = mikt(ji,jj) 
    170                      zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 
     166                     zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 
    171167                  END DO 
    172168               END DO 
    173169            ELSE 
    174                zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 
     170               zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 
    175171            END IF 
    176172         END IF 
     
    293289      IF( l_ar5 ) THEN 
    294290        DEALLOCATE( zarea_ssh , zbotpres, z2d ) 
    295         DEALLOCATE( zrhd      , zrhop    ) 
    296291        DEALLOCATE( ztsn                 ) 
    297292      ENDIF 
     
    367362      IF(   iom_use( 'voltot'  ) .OR. iom_use( 'sshtot'    )  .OR. iom_use( 'sshdyn' )  .OR.  &  
    368363         &  iom_use( 'masstot' ) .OR. iom_use( 'temptot'   )  .OR. iom_use( 'saltot' ) .OR.  &     
    369          &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) L_ar5 = .TRUE. 
     364         &  iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' ) .OR. & 
     365         &  iom_use( 'rhop' )  ) L_ar5 = .TRUE. 
    370366   
    371367      IF( l_ar5 ) THEN 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DIA/diawri.F90

    r12933 r13121  
    171171         CALL iom_put( "sbs", z2d )                ! bottom salinity 
    172172      ENDIF 
     173 
     174      CALL iom_put( "rhop", rhop(:,:,:) )          ! 3D potential density (sigma0) 
    173175 
    174176      IF ( iom_use("taubot") ) THEN                ! bottom stress 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DOM/dommsk.F90

    r12377 r13121  
    259259               ENDIF 
    260260            END DO 
    261 #if defined key_agrif  
    262             IF( .NOT. AGRIF_Root() ) THEN  
    263                IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east  
    264                IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west  
    265                IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north  
    266                IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south  
    267             ENDIF  
    268 #endif  
    269261         END DO 
    270262         ! 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DOM/istate.F90

    r12489 r13121  
    2424   USE dom_oce        ! ocean space and time domain  
    2525   USE daymod         ! calendar 
    26    USE divhor         ! horizontal divergence            (div_hor routine) 
    2726   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
    2827   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
     
    121120         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
    122121         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
    123          hdiv(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    124          CALL div_hor( 0, Kbb, Kmm )         ! compute interior hdiv value   
    125 !!gm                                    hdiv(:,:,:) = 0._wp 
    126122 
    127123!!gm POTENTIAL BUG : 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DYN/divhor.F90

    r12377 r13121  
    8484      END_3D 
    8585      ! 
    86 #if defined key_agrif 
    87       IF( .NOT. Agrif_Root() ) THEN 
    88          IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
    89          IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
    90          IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
    91          IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
    92       ENDIF 
    93 #endif 
    94       ! 
    9586      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field) 
    9687      ! 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/DYN/sshwzv.F90

    r12489 r13121  
    202202#if defined key_agrif  
    203203      IF( .NOT. AGRIF_Root() ) THEN  
    204          IF ((nbondi ==  1).OR.(nbondi == 2)) pww(nlci-1 , :     ,:) = 0.e0      ! east  
    205          IF ((nbondi == -1).OR.(nbondi == 2)) pww(2      , :     ,:) = 0.e0      ! west  
    206          IF ((nbondj ==  1).OR.(nbondj == 2)) pww(:      ,nlcj-1 ,:) = 0.e0      ! north  
    207          IF ((nbondj == -1).OR.(nbondj == 2)) pww(:      ,2      ,:) = 0.e0      ! south  
     204         ! Mask vertical velocity at first/last columns/row  
     205         ! inside computational domain (cosmetic)  
     206         ! --- West --- ! 
     207         DO ji = mi0(2), mi1(2) 
     208            DO jj = 1, jpj 
     209               pww(ji,jj,:) = 0._wp  
     210            ENDDO 
     211         ENDDO 
     212         ! 
     213         ! --- East --- ! 
     214         DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 
     215            DO jj = 1, jpj 
     216               pww(ji,jj,:) = 0._wp 
     217            ENDDO 
     218         ENDDO 
     219         ! 
     220         ! --- South --- ! 
     221         DO jj = mj0(2), mj1(2) 
     222            DO ji = 1, jpi 
     223               pww(ji,jj,:) = 0._wp 
     224            ENDDO 
     225         ENDDO 
     226         ! 
     227         ! --- North --- ! 
     228         DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 
     229            DO ji = 1, jpi 
     230               pww(ji,jj,:) = 0._wp 
     231            ENDDO 
     232         ENDDO 
    208233      ENDIF  
    209234#endif  
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ICB/icbrst.F90

    r12933 r13121  
    192192      CHARACTER(len=256)     :: cl_path 
    193193      CHARACTER(len=256)     :: cl_filename 
    194       CHARACTER(len=256)     :: cl_kt 
     194      CHARACTER(len=)     :: cl_kt 
    195195      CHARACTER(LEN=12 )     :: clfmt            ! writing format 
    196196      TYPE(iceberg), POINTER :: this 
     
    213213         ! file name 
    214214         WRITE(cl_kt, '(i8.8)') kt 
    215          cl_filename = TRIM(cexper)//"_"//TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out) 
     215         cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 
    216216         IF( lk_mpp ) THEN 
    217             idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
    218             WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
    219             WRITE(cl_filename,clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
     217            idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     218            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     219            WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
    220220         ELSE 
    221             WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename) 
     221            WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    222222         ENDIF 
    223223 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ICB/icbtrj.F90

    r12933 r13121  
    6666      CHARACTER(len=80)      ::   cl_filename 
    6767      CHARACTER(LEN=12)      ::   clfmt            ! writing format 
    68       CHARACTER(LEN=20)      ::   cldate_ini, cldate_end 
     68      CHARACTER(LEN=8 )      ::   cldate_ini, cldate_end 
    6969      TYPE(iceberg), POINTER ::   this 
    7070      TYPE(point)  , POINTER ::   pt 
     
    8282 
    8383      ! define trajectory output name 
    84       cl_filename = 'trajectory_icebergs_'//TRIM(ADJUSTL(cldate_ini))//'-'//TRIM(ADJUSTL(cldate_end)) 
     84      cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 
    8585      IF ( lk_mpp ) THEN 
    86          idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
    87          WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
    88          WRITE(cl_filename,clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
     86         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     87         WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     88         WRITE(cl_filename,  clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 
    8989      ELSE 
    90          WRITE(cl_filename,'(A,".nc")') TRIM(cl_filename) 
     90         WRITE(cl_filename,'(a,a)') TRIM(cl_filename),               '.nc' 
    9191      ENDIF 
    9292      IF( lwp .AND. nn_verbose_level >= 0 )   WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/IOM/iom_def.F90

    r12649 r13121  
    3333   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    3434   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    35    INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
     35   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3636 
    3737 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/IOM/iom_nf90.F90

    r12933 r13121  
    111111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    112112            IF( jpnij > 1 ) THEN 
    113                idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
    114                WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg   ! '(a,a,ix.x,a)' 
     113               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     114               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
    115115               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    116116               cdname = TRIM(cltmp) 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/LBC/lib_mpp.F90

    r12933 r13121  
    11141114      ! 
    11151115      CHARACTER(LEN=8) ::   clfmt            ! writing format 
    1116       INTEGER ::   inum 
    1117       INTEGER ::   idg  ! number of digits 
     1116      INTEGER          ::   inum 
    11181117      !!---------------------------------------------------------------------- 
    11191118      ! 
    11201119      nstop = nstop + 1 
    11211120      ! 
    1122       IF( numout == 6 ) THEN                          ! force to open ocean.output file if not already opened 
    1123          CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    1124       ELSE 
    1125          IF( narea > 1 .AND. cd1 == 'STOP' ) THEN     ! add an error message in ocean.output 
    1126             CALL ctl_opn( inum,'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    1127             WRITE(inum,*) 
    1128             idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
    1129             WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg     ! '(a,ix.x)' 
    1130             WRITE(inum,clfmt) ' ===>>> : see E R R O R in ocean.output_', narea - 1 
    1131          ENDIF 
     1121      IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN    ! Immediate stop: add an arror message in 'ocean.output' file 
     1122         CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1123         WRITE(inum,*) 
     1124         WRITE(inum,*) ' ==>>>   Look for "E R R O R" messages in all existing *ocean.output* files' 
     1125         CLOSE(inum) 
     1126      ENDIF 
     1127      IF( numout == 6 ) THEN                       ! force to open ocean.output file if not already opened 
     1128         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
    11321129      ENDIF 
    11331130      ! 
     
    12241221      CHARACTER(LEN=10) ::   clfmt            ! writing format 
    12251222      INTEGER           ::   iost 
    1226       INTEGER           ::   idg  ! number of digits 
     1223      INTEGER           ::   idg              ! number of digits 
    12271224      !!---------------------------------------------------------------------- 
    12281225      ! 
     
    12321229      IF( PRESENT( karea ) ) THEN 
    12331230         IF( karea > 1 ) THEN 
    1234             idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
    1235             WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg   ! '(a,a,ix.x)' 
     1231            ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 
     1232            idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 )      ! how many digits to we need to write? min=4, max=9 
     1233            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg          ! '(a,a,ix.x)' 
    12361234            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 
    12371235         ENDIF 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcblk.F90

    r12925 r13121  
    628628      END SELECT 
    629629 
     630      CALL iom_put("Cd_oce", zcd_oce) 
     631      CALL iom_put("Ce_oce", zce_oce) 
     632      CALL iom_put("Ch_oce", zch_oce) 
     633       
    630634      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    631635         !! ptsk and pssq have been updated!!! 
     
    878882         Ce_ice(:,:) = Ch_ice(:,:)       ! sensible and latent heat transfer coef. are considered identical 
    879883      ENDIF 
    880  
    881       !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice)   ! output value of pure ice-atm. transfer coef. 
    882       !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice)   ! output value of pure ice-atm. transfer coef. 
    883  
     884       
     885      CALL iom_put("Cd_ice", Cd_ice) 
     886      CALL iom_put("Ce_ice", Ce_ice) 
     887      CALL iom_put("Ch_ice", Ch_ice) 
     888       
    884889      ! local scalars ( place there for vector optimisation purposes) 
    885890      zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbccpl.F90

    r12952 r13121  
    17851785            ENDDO 
    17861786         ELSE 
    1787             qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1787            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17881788            DO jl = 1, jpl 
    1789                zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17901789               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    17911790            END DO 
     
    19281927            END DO 
    19291928         ELSE 
    1930             qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1929            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19311930            DO jl = 1, jpl 
    1932                zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19331931               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    19341932            END DO 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcmod.F90

    r12489 r13121  
    120120      ncom_fsbc = nn_fsbc    ! make nn_fsbc available for lib_mpp 
    121121#endif 
    122       !                             !* overwrite namelist parameter using CPP key information 
    123 #if defined key_agrif 
    124       IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
    125          IF( lk_si3  )   nn_ice      = 2 
    126          IF( lk_cice )   nn_ice      = 3 
    127       ENDIF 
    128 !!GS: TBD 
    129 !#else 
    130 !      IF( lk_si3  )   nn_ice      = 2 
    131 !      IF( lk_cice )   nn_ice      = 3 
    132 #endif 
    133122      ! 
    134123      IF(lwp) THEN                  !* Control print 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/SBC/sbcwave.F90

    r12377 r13121  
    210210      END_3D 
    211211      ! 
    212 #if defined key_agrif 
    213       IF( .NOT. Agrif_Root() ) THEN 
    214          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
    215          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
    216          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
    217          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
    218       ENDIF 
    219 #endif 
    220       ! 
    221212      CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 
    222213      ! 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/TRD/trdtra.F90

    r12489 r13121  
    8282      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   ptra    ! now tracer variable 
    8383      ! 
    84       INTEGER ::   jk   ! loop indices 
     84      INTEGER ::   jk    ! loop indices 
     85      INTEGER ::   i01   ! 0 or 1 
    8586      REAL(wp),        DIMENSION(jpi,jpj,jpk) ::   ztrds             ! 3D workspace 
    8687      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwt, zws, ztrdt   ! 3D workspace 
     
    9091         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
    9192      ENDIF 
    92  
     93      ! 
     94      i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 
     95      ! 
    9396      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
    9497         ! 
    95          SELECT CASE( ktrd ) 
     98         SELECT CASE( ktrd*i01 ) 
    9699         !                            ! advection: transform the advective flux into a trend 
    97100         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm )  
     
    112115      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
    113116         ! 
    114          SELECT CASE( ktrd ) 
     117         SELECT CASE( ktrd*i01 ) 
    115118         !                            ! advection: transform the advective flux into a trend 
    116119         !                            !            and send T & S trends to trd_tra_mng 
     
    163166      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
    164167         ! 
    165          SELECT CASE( ktrd ) 
     168         SELECT CASE( ktrd*i01 ) 
    166169         !                            ! advection: transform the advective flux into a masked trend 
    167170         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm )  
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/ZDF/zdftke.F90

    r12702 r13121  
    4545   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    4646   USE zdfmxl         ! vertical physics: mixed layer 
     47#if defined key_si3 
     48   USE ice, ONLY: hm_i, h_i 
     49#endif 
     50#if defined key_cice 
     51   USE sbc_ice, ONLY: h_i 
     52#endif 
    4753   ! 
    4854   USE in_out_manager ! I/O manager 
     
    6470   INTEGER  ::   nn_mxl    ! type of mixing length (=0/1/2/3) 
    6571   REAL(wp) ::   rn_mxl0   ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m] 
     72   INTEGER  ::      nn_mxlice ! type of scaling under sea-ice 
     73   REAL(wp) ::      rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    6674   INTEGER  ::   nn_pdl    ! Prandtl number or not (ratio avt/avm) (=0/1) 
    6775   REAL(wp) ::   rn_ediff  ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
     
    422430      REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars 
    423431      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    424       REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
     432      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    425433      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
    426434      !!-------------------------------------------------------------------- 
     
    436444      zmxld(:,:,:)  = rmxl_min 
    437445      ! 
    438       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     446     IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     447         ! 
    439448         zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
     449#if ! defined key_si3 && ! defined key_cice 
    440450         DO_2D_00_00 
    441             zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
     451            zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    442452         END_2D 
    443       ELSE  
     453#else 
     454         SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     455         ! 
     456         CASE( 0 )                      ! No scaling under sea-ice 
     457            DO_2D_00_00 
     458               zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     459            END_2D 
     460            ! 
     461         CASE( 1 )                           ! scaling with constant sea-ice thickness 
     462            DO_2D_00_00 
     463               zmxlm(ji,jj,1) =  ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 
     464            END_2D 
     465            ! 
     466         CASE( 2 )                                 ! scaling with mean sea-ice thickness 
     467            DO_2D_00_00 
     468#if defined key_si3 
     469               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 
     470#elif defined key_cice 
     471               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     472               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     473#endif 
     474            END_2D 
     475            ! 
     476         CASE( 3 )                                 ! scaling with max sea-ice thickness 
     477            DO_2D_00_00 
     478               zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     479               zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 
     480            END_2D 
     481            ! 
     482         END SELECT 
     483#endif 
     484         ! 
     485         DO_2D_00_00 
     486            zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
     487         END_2D 
     488         ! 
     489      ELSE 
    444490         zmxlm(:,:,1) = rn_mxl0 
    445491      ENDIF 
     492 
    446493      ! 
    447494      DO_3D_00_00( 2, jpkm1 ) 
     
    547594      INTEGER             ::   ios 
    548595      !! 
    549       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          & 
    550          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,          & 
    551          &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc,   & 
    552          &                 nn_etau , nn_htau  , rn_efr , rn_eice   
     596      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,  & 
     597         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,  & 
     598         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
     599         &                 nn_pdl  , ln_drg   , ln_lc    , rn_lc,      & 
     600         &                 nn_etau , nn_htau  , rn_efr   , rn_eice   
    553601      !!---------------------------------------------------------------------- 
    554602      ! 
     
    576624         WRITE(numout,*) '      mixing length type                          nn_mxl    = ', nn_mxl 
    577625         WRITE(numout,*) '         surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0 
     626         IF( ln_mxl0 ) THEN 
     627            WRITE(numout,*) '      type of scaling under sea-ice               nn_mxlice = ', nn_mxlice 
     628            IF( nn_mxlice == 1 ) & 
     629            WRITE(numout,*) '      ice thickness when scaling under sea-ice    rn_mxlice = ', rn_mxlice 
     630         ENDIF          
    578631         WRITE(numout,*) '         surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0 
    579632         WRITE(numout,*) '      top/bottom friction forcing flag            ln_drg    = ', ln_drg 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/nemogcm.F90

    r12933 r13121  
    232232         IF( ngrdstop > 0 ) THEN 
    233233            WRITE(ctmp9,'(i2)') ngrdstop 
    234             WRITE(ctmp2,*) '      ==>>>   Error detected in Agrif grid '//TRIM(ctmp9) 
    235             WRITE(ctmp3,*) '      ==>>>   look for error messages in '//TRIM(ctmp9)//'_ocean_output* files' 
    236             CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
     234            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     235            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     236            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
    237237         ELSE 
    238             CALL ctl_stop( ctmp1 ) 
     238            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     239            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    239240         ENDIF 
    240241      ENDIF 
     
    249250#else 
    250251      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    251       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
     252      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications 
    252253      ENDIF 
    253254#endif 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OCE/stpctl.F90

    r12933 r13121  
    130130      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
    131131      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
    132       IF( ll_colruns ) THEN     ! following variables are used only in the netcdf file 
     132      IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
    133133         zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
    134134         zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     
    220220         ! 
    221221         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    222             IF(lwp)   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     222            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     223            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     224            ENDIF 
    223225         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
    224226            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    225227         ENDIF 
    226228         ! 
    227          IF( nstop == 0 )   nstop = 1  
    228          ngrdstop = Agrif_Fixed() 
    229          ! 
     229      ENDIF 
     230      ! 
     231      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     232         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     233         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
    230234      ENDIF 
    231235      ! 
     
    260264      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
    261265      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
    262       WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij-1,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     266      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
    263267      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
    264268                                   WRITE(clmax, cl4) kmax-1 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/OFF/nemogcm.F90

    r12933 r13121  
    147147      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
    148148         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    149          CALL ctl_stop( ctmp1 ) 
     149         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     150         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    150151      ENDIF 
    151152      ! 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/SAS/nemogcm.F90

    r12933 r13121  
    162162         IF( ngrdstop > 0 ) THEN 
    163163            WRITE(ctmp9,'(i2)') ngrdstop 
    164             WRITE(ctmp2,*) '      ==>>>   Error detected in Agrif grid '//TRIM(ctmp9) 
    165             WRITE(ctmp3,*) '      ==>>>   look for error messages in '//TRIM(ctmp9)//'_ocean_output* files' 
    166             CALL ctl_stop( ctmp1, ctmp2, ctmp3 ) 
     164            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     165            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     166            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
    167167         ELSE 
    168             CALL ctl_stop( ctmp1 ) 
     168            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     169            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    169170         ENDIF 
    170171      ENDIF 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/SAS/stpctl.F90

    r12933 r13121  
    180180         ! 
    181181         IF( ll_colruns .or. jpnij == 1 ) THEN   ! all processes synchronized -> use lwp to print in opened ocean.output files 
    182             IF(lwp)   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     182            IF(lwp) THEN   ;   CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
     183            ELSE           ;   nstop = MAX(1, nstop)   ! make sure nstop > 0 (automatically done when calling ctl_stop) 
     184            ENDIF 
    183185         ELSE                                    ! only mpi subdomains with errors are here -> STOP now 
    184186            CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 
    185187         ENDIF 
    186188         ! 
    187          IF( nstop == 0 )   nstop = 1  
    188          ngrdstop = Agrif_Fixed() 
    189          ! 
     189      ENDIF 
     190      ! 
     191      IF( nstop > 0 ) THEN                                                  ! an error was detected and we did not abort yet... 
     192         ngrdstop = Agrif_Fixed()                                           ! store which grid got this error 
     193         IF( .NOT. ll_colruns .AND. jpnij > 1 )   CALL ctl_stop( 'STOP' )   ! we must abort here to avoid MPI deadlock 
    190194      ENDIF 
    191195      ! 
     
    220224      !!! WRITE(clsum, '(i'//clfmt//')') ksum                   ! this is creating a compilation error with AGRIF 
    221225      cl4 = '(i'//clfmt//')'   ;   WRITE(clsum, cl4) ksum 
    222       WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij-1,wp))) + 1     ! how many digits to we need to write ? (we decide max = 9) 
     226      WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1    ! how many digits to we need to write ? (we decide max = 9) 
    223227      cl4 = '(i'//clfmt//')'   ;   WRITE(clmin, cl4) kmin-1 
    224228                                   WRITE(clmax, cl4) kmax-1 
  • NEMO/branches/2020/dev_r12953_ENHANCE-10_acc_fix_traqsr/src/TOP/PISCES/P4Z/p4zsms.F90

    r12489 r13121  
    206206      IF( l_trdtrc ) THEN 
    207207         DO jn = jp_pcs0, jp_pcs1 
    208            ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact2r  
     208           ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
    209209           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    210210         END DO 
Note: See TracChangeset for help on using the changeset viewer.