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 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP – NEMO

Ignore:
Timestamp:
2020-12-03T12:20:38+01:00 (4 years ago)
Author:
ayoung
Message:

Updated to trunk at 14020. Sette tests passed with change of results for configurations with non-linear ssh. Ticket #2506.

Location:
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette_wave@13990         sette 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/C14/trcatm_c14.F90

    r13295 r14037  
    120120            IF( ierr3 /= 0 )   CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 
    121121      ! 
    122             DO_2D( 1, 1, 1, 1 ) 
     122            DO_2D( 1, 1, 1, 1 )                 ! from C14b package 
    123123              IF( gphit(ji,jj) >= yn40 ) THEN 
    124124                 fareaz(ji,jj,1) = 0. 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/C14/trcsms_c14.F90

    r13295 r14037  
    144144         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    145145         ! 
    146          CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )       ! These five need      & 
    147          CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc )     ! &    to be written   & 
     146         CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) ! These five need      & 
     147         CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc ) ! &    to be written   & 
    148148         CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! &    for temporal    & 
    149149         CALL iom_rstput( kt, nitrst, numrtw, 'exch_c14', exch_c14 ) ! &    averages        & 
    150          CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 )  ! &    to be coherent. 
     150         CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14   ) ! &    to be coherent. 
    151151         CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) ! Cumulative 
    152152         ! 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/CFC/trcsms_cfc.F90

    r13295 r14037  
    126126          
    127127         !                                                         !------------! 
    128          DO_2D( 1, 1, 1, 1 ) 
    129   
     128         DO_2D( 1, 1, 1, 1 )                                       !  i-j loop  ! 
     129            !                                                      !------------! 
    130130            ! space interpolation 
    131131            zpp_cfc  =       xphem(ji,jj)   * zpatm(1,jl)   & 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P2Z/p2zopt.F90

    r13295 r14037  
    9595      !                                          ! Photosynthetically Available Radiation (PAR) 
    9696      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    97       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     97      DO_3D( 1, 1, 1, 1, 2, jpk )                     ! local par at w-levels 
    9898         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
    9999         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    102102         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
    103103      END_3D 
    104       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     104      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! mean par at t-levels 
    105105         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
    106106         zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    … …  
    114114      !                                          ! -------------- 
    115115      neln(:,:) = 1                                   ! euphotic layer level 
    116       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     116      DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! (i.e. 1rst T-level strictly below EL bottom) 
    117117        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1  
    118118      END_3D 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13295 r14037  
    118118         ! 
    119119         zfeequi = zFe3(ji,jj,jk) * 1E-9 
    120          zhplus  = max( rtrn, hi(ji,jj,jk) ) 
    121          fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
    122             &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
    123             &         + fesol(ji,jj,jk,5) / zhplus ) 
    124120         zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
    125121         ! precipitation of Fe3+, creation of nanoparticles 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P4Z/p4zlim.F90

    r13295 r14037  
    161161         zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    162162         zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
    163          zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     163         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 
    164164         zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
    165165         zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P4Z/p4zsed.F90

    r13295 r14037  
    313313      ENDIF 
    314314      ! 
    315       IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
     315      IF(sn_cfctl%l_prttrc) THEN  ! print mean trneds (USEd for debugging) 
    316316         WRITE(charout, fmt="('sed ')") 
    317317         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    … …  
    366366      lk_sed = ln_sediment .AND. ln_sed_2way  
    367367      ! 
     368      nitrpot(:,:,jpk) = 0._wp   ! define last level for iom_put 
     369      ! 
    368370   END SUBROUTINE p4z_sed_init 
    369371 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P4Z/p4zsms.F90

    r13295 r14037  
    6969      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zw2d 
    7070      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zw3d 
    71       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt   ! 4D workspace 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio 
    7272 
    7373      !!--------------------------------------------------------------------- 
    … …  
    9393      rfact = rDt_trc 
    9494      ! 
    95       ! trends computation initialisation 
    96       IF( l_trdtrc )  THEN 
    97          ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter 
    98          ztrdt(:,:,:,:)  = tr(:,:,:,:,Kmm) 
    99       ENDIF 
    100       ! 
    101  
    10295      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 
    10396         rfactr  = 1. / rfact 
    … …  
    117110         END DO 
    118111      ENDIF 
     112 
     113      DO jn = jp_pcs0, jp_pcs1              !   Store the tracer concentrations before entering PISCES 
     114         ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb) 
     115      END DO 
     116 
    119117      ! 
    120118      IF( ll_bc )    CALL p4z_bc( kt, Kbb, Kmm, Krhs )   ! external sources of nutrients  
    … …  
    198196         END DO 
    199197         ! 
    200          IF( ln_top_euler ) THEN 
    201             DO jn = jp_pcs0, jp_pcs1 
    202                tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    203             END DO 
    204          ENDIF 
     198      END DO 
     199      ! 
     200#endif 
     201      ! 
     202      IF( ln_sediment ) THEN  
     203         ! 
     204         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
     205         ! 
     206      ENDIF 
     207      ! 
     208      DO jn = jp_pcs0, jp_pcs1 
     209         tr(:,:,:,jn,Krhs) = ( tr(:,:,:,jn,Kbb) - ztrbbio(:,:,:,jn) ) * rfactr 
     210         tr(:,:,:,jn,Kbb ) = ztrbbio(:,:,:,jn) 
     211         ztrbbio(:,:,:,jn) = 0._wp 
    205212      END DO 
    206213      ! 
    207214      IF( l_trdtrc ) THEN 
    208215         DO jn = jp_pcs0, jp_pcs1 
    209            ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr  
    210216           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    211217         END DO 
    212          DEALLOCATE( ztrdt )  
    213218      END IF 
    214 #endif 
    215       ! 
    216       IF( ln_sediment ) THEN  
    217          ! 
    218          CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    219          ! 
    220          IF( ln_top_euler ) THEN 
    221             DO jn = jp_pcs0, jp_pcs1 
    222                tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    223             END DO 
    224          ENDIF 
    225          ! 
    226       ENDIF 
    227       ! 
     219      !   
    228220      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
    229221      ! 
    … …  
    377369            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    378370         ENDIF 
    379          CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 
    380          CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
     371         CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:)           ) 
     372         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:)    ) 
    381373         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    382374         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/P4Z/p5zlim.F90

    r13295 r14037  
    306306         &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   & 
    307307         &          * xqndmax(ji,jj,jk) / (zration + rtrn) 
    308          zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     308         zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 
    309309         zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 
    310310         xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/SED/sed.F90

    r10425 r14037  
    4444   REAL    , PUBLIC               ::  sedmask 
    4545   REAL(wp), PUBLIC               ::  denssol                !: density of solid material 
    46    INTEGER , PUBLIC               ::  numrsr, numrsw   !: logical unit for sed restart (read and write) 
    4746   LOGICAL , PUBLIC               ::  lrst_sed       !: logical to control the trc restart write 
    4847   LOGICAL , PUBLIC               ::  ln_rst_sed  = .TRUE.     !: initialisation from a restart file or not 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/SED/sedrst.F90

    r13286 r14037  
    4242      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
    4343      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
     44      CHARACTER(LEN=52)   ::   clpname   ! trc output restart file name including AGRIF 
    4445      !!---------------------------------------------------------------------- 
    4546      ! 
    … …  
    8081         IF(lwp) WRITE(numsed,*) & 
    8182             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname 
    82          CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 
     83         IF(.NOT.lwxios) THEN 
     84            CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 
     85         ELSE 
     86#if defined key_iomput 
     87            cw_sedrst_cxt = "rstws_"//TRIM(ADJUSTL(clkt)) 
     88            IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     89               clpname = clname 
     90            ELSE 
     91               clpname = TRIM(Agrif_CFixed())//"_"//clname 
     92            ENDIF 
     93            numrsw = iom_xios_setid(TRIM(clpath)//TRIM(clpname)) 
     94            CALL iom_init( cw_sedrst_cxt, kdid = numrsw, ld_closedef = .FALSE. ) 
     95#else 
     96               clinfo = 'Can not use XIOS in trc_rst_opn' 
     97               CALL ctl_stop(TRIM(clinfo)) 
     98#endif 
     99            ENDIF 
     100 
    83101         lrst_sed = .TRUE. 
    84102      ENDIF 
    … …  
    196214      CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), & 
    197215         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) ) 
    198  
    199216      IF( ln_timing )  CALL timing_stop('sed_rst_read') 
    200217      
    … …  
    240257      !! 1. WRITE in nutwrs 
    241258      !! ------------------ 
    242  
    243       zinfo(1) = REAL( kt) 
    244       CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo  ) 
     259!     zinfo(1) = REAL( kt) 
     260      CALL iom_rstput( kt, nitrst, numrsw, 'kt', REAL( kt    , wp) ) 
    245261 
    246262      ! Back to 2D geometry 
    … …  
    299315 
    300316      IF( kt == nitrst ) THEN 
    301           CALL iom_close( numrsw )     ! close the restart file (only at last time step) 
     317          IF(.NOT.lwxios) THEN 
     318             CALL iom_close( numrsw )     ! close the restart file (only at last time step) 
     319          ELSE 
     320             CALL iom_context_finalize( cw_sedrst_cxt )  
     321             iom_file(numrsw)%nfid       = 0 
     322             numrsw = 0 
     323          ENDIF 
    302324          IF( l_offline .AND. ln_rst_list ) THEN 
    303325             nrst_lst = nrst_lst + 1 
    … …  
    342364      REAL(wp) ::  zkt, zrdttrc1 
    343365      REAL(wp) ::  zndastp 
     366      CHARACTER(len = 82) :: clpname 
    344367 
    345368      ! Time domain : restart 
    … …  
    353376 
    354377         IF( ln_rst_sed ) THEN 
     378            lxios_sini = .FALSE. 
    355379            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr ) 
     380 
     381            IF( lrxios) THEN 
     382                cr_sedrst_cxt = 'sed_rst' 
     383                IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for SED' 
     384!               IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     385!                  clpname = cn_sedrst_in 
     386!               ELSE 
     387!                  clpname = TRIM(Agrif_CFixed())//"_"//cn_sedrst_in    
     388!               ENDIF 
     389                CALL iom_init( cr_sedrst_cxt, kdid = numrsr, ld_closedef = .TRUE. ) 
     390            ENDIF 
    356391            CALL iom_get ( numrsr, 'kt', zkt )   ! last time-step of previous run 
    357  
    358392            IF(lwp) THEN 
    359393               WRITE(numsed,*) ' *** Info read in restart : ' 
    … …  
    402436            IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 
    403437            IF(lwp) WRITE(numsed,*) '~~~~~~~' 
     438            IF( lwxios ) CALL iom_init_closedef(cw_sedrst_cxt) 
    404439         ENDIF 
    405440         CALL iom_rstput( kt, nitrst, numrsw, 'kt'     , REAL( kt    , wp) )   ! time-step 
    406441         CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) )   ! date 
    407          CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj            )   ! number of elapsed days since 
    408          !                                                                     ! the begining of the run [s] 
     442         CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj )   ! number of elapsed days since 
     443         !                                                                                      ! the begining of the run [s] 
    409444      ENDIF 
    410445 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/PISCES/SED/sedstp.F90

    r12489 r14037  
    8686      IF( kt == nitsed000 ) THEN 
    8787          CALL iom_close( numrsr )       ! close input tracer restart file 
    88 !          IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
     88          IF(lrxios) CALL iom_context_finalize(      cr_sedrst_cxt  ) 
     89!         IF(lwm) CALL FLUSH( numont )   ! flush namelist output 
    8990      ENDIF 
    9091      IF( lrst_sed )            CALL sed_rst_wri( kt )   ! restart file output 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/TRP/trcadv.F90

    r13286 r14037  
    2222   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2323   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
     24   USE traadv_fct_lf  ! FCT      scheme           (tra_adv_fct  routine - loop fusion version) 
    2425   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
     26   USE traadv_mus_lf  ! MUSCL    scheme           (tra_adv_mus  routine - loop fusion version) 
    2527   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
    2628   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
    … …  
    124126      ! 
    125127      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
     128         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 
    126129         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    127130      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    128          CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
     131         IF (nn_hls.EQ.2) THEN 
     132            CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
     133            CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
     134#if defined key_loop_fusion 
     135            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
     136#else 
     137            CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
     138#endif 
     139         ELSE 
     140            CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
     141         END IF 
    129142      CASE ( np_MUS )                                 ! MUSCL 
    130          CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups         )  
     143         IF (nn_hls.EQ.2) THEN 
     144            IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
     145#if defined key_loop_fusion 
     146            CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
     147#else 
     148            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
     149#endif 
     150         ELSE 
     151            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
     152         END IF 
    131153      CASE ( np_UBS )                                 ! UBS 
     154         IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    132155         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
    133156      CASE ( np_QCK )                                 ! QUICKEST 
     157         IF (nn_hls.EQ.2) THEN 
     158            CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
     159            CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
     160         END IF 
    134161         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    135162      ! 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/TRP/trcldf.F90

    r13295 r14037  
    101101           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    102102      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
     103         IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.) 
    103104         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    104105           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/TRP/trdmxl_trc.F90

    r13295 r14037  
    148148         ! ... Weights for vertical averaging 
    149149         wkx_trc(:,:,:) = 0.e0 
    150          DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) 
     150         DO_3D( 1, 1, 1, 1, 1, jpktrd_trc )                       ! initialize wkx_trc with vertical scale factor in mixed-layer 
    151151            IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 
    152152         END_3D 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/trc.F90

    r12489 r14037  
    2121   INTEGER, PUBLIC ::   numonr     = -1   !: reference passive tracer namelist output output.namelist.top 
    2222   INTEGER, PUBLIC ::   numstr            !: tracer statistics 
    23    INTEGER, PUBLIC ::   numrtr            !: trc restart (read ) 
    24    INTEGER, PUBLIC ::   numrtw            !: trc restart ( write ) 
    2523   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_ref   !: character buffer for reference passive tracer namelist_top_ref 
    2624   CHARACTER(:), ALLOCATABLE, PUBLIC ::   numnat_cfg   !: character buffer for configuration specific passive tracer namelist_top_cfg 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/trcbdy.F90

    r13226 r14037  
    4949      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    5050      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    51       REAL(wp), POINTER                 ::  zfac 
    5251      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
    5352      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    … …  
    6160         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
    6261         ELSE                 ;   llrim0 = .FALSE. 
    63          END IF 
     62         ENDIF 
    6463         DO ib_bdy=1, nb_bdy 
     64            ! 
    6565            DO jn = 1, jptra 
    6666               ! 
    67                ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    68                zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     67               IF( ASSOCIATED(trcdta_bdy(jn,ib_bdy)%trc) .AND. trcdta_bdy(jn,ib_bdy)%cn_obc /= 'neumann' ) THEN 
     68                  IF( .NOT. ASSOCIATED(ztrc) )   ALLOCATE( ztrc(idx_bdy(ib_bdy)%nblen(igrd),jpk) ) 
     69                  ztrc(:,:) = trcdta_bdy(jn,ib_bdy)%trc(:,:) * trcdta_bdy(jn,ib_bdy)%rn_fac 
     70               ENDIF 
    6971               ! 
    70                SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     72               SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    7173               CASE('none'        )   ;   CYCLE 
    7274               CASE('frs'         )   ! treat the whole boundary at once 
    73                   IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     75                  IF( ir == 0 )           CALL bdy_frs( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
    7476               CASE('specified'   )   ! treat the whole rim      at once 
    75                   IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
    76                CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked 
    77                CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 
    78                CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 
     77                  IF( ir == 0 )           CALL bdy_spe( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
     78               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd            , tr(:,:,:,jn,Krhs),       llrim0 )   ! tra masked 
     79               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     80                  &                                     ll_npo=.FALSE. ) 
     81               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     82                  &                                     ll_npo=.TRUE.  ) 
    7983               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    8084               END SELECT 
    8185               ! 
    8286            END DO 
     87            ! 
     88            IF( ASSOCIATED(ztrc) )   DEALLOCATE(ztrc) 
     89            ! 
    8390         END DO 
    8491         ! 
    8592         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
    86          IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     93         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   ENDIF 
    8794         DO ib_bdy=1, nb_bdy 
    88             SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     95            SELECT CASE( cn_tra(ib_bdy) ) 
    8996            CASE('neumann') 
    9097               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    … …  
    97104         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    98105            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    99          END IF 
     106         ENDIF 
    100107         ! 
    101108      END DO   ! ir 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/trcdta.F90

    r13295 r14037  
    199199               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    200200            ENDIF 
    201             DO_2D( 1, 1, 1, 1 ) 
     201            DO_2D( 1, 1, 1, 1 )                 ! vertical interpolation of T & S 
    202202               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    203203                  zl = gdept(ji,jj,jk,Kmm) 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/trcrst.F90

    r13286 r14037  
    5252      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
    5353      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
     54      CHARACTER(LEN=50)   ::   clpname  ! trc output restart file name including AGRIF 
    5455      !!---------------------------------------------------------------------- 
    5556      ! 
    … …  
    9192         IF(lwp) WRITE(numout,*) & 
    9293             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname 
    93          CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE. ) 
     94         IF(.NOT.lwxios) THEN 
     95            CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE. ) 
     96         ELSE 
     97#if defined key_iomput 
     98            cw_toprst_cxt = "rstwt_"//TRIM(ADJUSTL(clkt)) 
     99            IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     100               clpname = clname 
     101            ELSE 
     102               clpname = TRIM(Agrif_CFixed())//"_"//clname 
     103            ENDIF 
     104            numrtw = iom_xios_setid(TRIM(clpath)//TRIM(clpname)) 
     105            CALL iom_init( cw_toprst_cxt, kdid = numrtw, ld_closedef = .FALSE. ) 
     106#else 
     107               clinfo = 'Can not use XIOS in trc_rst_opn' 
     108               CALL ctl_stop(TRIM(clinfo)) 
     109#endif 
     110            ENDIF 
    94111         lrst_trc = .TRUE. 
    95112      ENDIF 
    … …  
    121138      END DO 
    122139      ! 
    123       CALL iom_delay_rst( 'READ', 'TOP', numrtr )   ! read only TOP delayed global communication variables 
    124        
     140      IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'TOP', numrtr )   ! read only TOP delayed global communication variables 
    125141   END SUBROUTINE trc_rst_read 
    126142 
    … …  
    147163         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    148164      END DO 
    149       ! 
    150       CALL iom_delay_rst( 'WRITE', 'TOP', numrtw )   ! save only TOP delayed global communication variables 
     165 
     166      IF( .NOT. lwxios ) CALL iom_delay_rst( 'WRITE', 'TOP', numrtw )   ! save only TOP delayed global communication variables 
    151167     
    152168      IF( kt == nitrst ) THEN 
    153169          CALL trc_rst_stat( Kmm, Krhs )             ! statistics 
    154           CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
     170          IF(lwxios) THEN 
     171             CALL iom_context_finalize(      cw_toprst_cxt          ) 
     172             iom_file(numrtw)%nfid       = 0 
     173             numrtw = 0 
     174          ELSE 
     175             CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
     176          ENDIF 
    155177#if ! defined key_trdmxl_trc 
    156178          lrst_trc = .FALSE. 
    … …  
    196218      REAL(wp) ::  zrdttrc1, zkt, zndastp, zdayfrac, ksecs, ktime 
    197219      INTEGER  ::   ihour, iminute 
     220      CHARACTER(len=82) :: clpname 
    198221 
    199222      ! Time domain : restart 
    … …  
    207230 
    208231         IF( ln_rsttr ) THEN 
     232            lxios_sini = .FALSE. 
    209233            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr ) 
     234            IF( lrxios) THEN 
     235                cr_toprst_cxt = 'top_rst' 
     236                IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for TOP' 
     237!               IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     238!                  clpname = cn_trcrst_in 
     239!               ELSE 
     240!                  clpname = TRIM(Agrif_CFixed())//"_"//cn_trcrst_in    
     241!               ENDIF 
     242                CALL iom_init( cr_toprst_cxt, kdid = numrtr, ld_closedef = .TRUE. ) 
     243            ENDIF 
     244 
    210245            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    211246 
    … …  
    237272               ! calculate start time in hours and minutes 
    238273               zdayfrac=adatrj-INT(adatrj) 
    239                ksecs = NINT(zdayfrac*86400)            ! Nearest second to catch rounding errors in adatrj               
     274               ksecs = NINT(zdayfrac*86400)            ! Nearest second to catch rounding errors in adatrj 
    240275               ihour = INT(ksecs/3600) 
    241276               iminute = ksecs/60-ihour*60 
    … …  
    258293               adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated             
    259294             ELSE 
     295               ndt05 = NINT( 0.5 * rn_Dt  )   !  --- WARNING --- not defined yet are we did not go through day_init 
    260296               ! parameters corresponding to nit000 - 1 (as we start the step 
    261297               ! loop with a call to day) 
    262                ndastp = ndate0 - 1       ! ndate0 read in the namelist in dom_nam 
     298               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam 
    263299               nhour   =   nn_time0 / 100 
    264300               nminute = ( nn_time0 - nhour * 100 ) 
    … …  
    292328            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    293329         ENDIF 
    294          CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step 
    295          CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date 
    296          CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since 
     330         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp)   )   ! time-step 
     331         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp)   )   ! date 
     332         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj              )   ! number of elapsed days since 
    297333         !                                                                     ! the begining of the run [s] 
    298          CALL iom_rstput( kt, nitrst, numrtw, 'ntime'  , REAL( nn_time0, wp)) ! time 
     334         CALL iom_rstput( kt, nitrst, numrtw, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    299335      ENDIF 
    300336 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/TOP/trcstp.F90

    r13286 r14037  
    110110      IF( kt == nittrc000 ) THEN 
    111111         CALL iom_close( numrtr )                         ! close input tracer restart file 
     112         IF(lrxios) CALL iom_context_finalize(      cr_toprst_cxt          ) 
    112113         IF(lwm) CALL FLUSH( numont )                     ! flush namelist output 
    113114      ENDIF 
    … …  
    196197           &                              .AND. iom_varid( numrtr, 'ktdcy'    , ldstop = .FALSE. ) > 0  & 
    197198           &                              .AND. iom_varid( numrtr, 'nrdcy'    , ldstop = .FALSE. ) > 0  ) THEN 
    198  
    199199            CALL iom_get( numrtr, 'ktdcy', zkt )   
    200200            rsecfst = INT( zkt ) * rn_Dt 
Note: See TracChangeset for help on using the changeset viewer.