Changeset 7083


Ignore:
Timestamp:
2016-10-25T12:12:41+02:00 (4 years ago)
Author:
malcolmroberts
Message:

Merged in dev_r5518_GO6_package up to revision 7076

Location:
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO
Files:
26 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6498 r7083  
    246246               ztest_1 = 1 
    247247            ELSE  
    248               ! this write is useful 
    249               IF(lwp)  WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(i_hemis)  
    250248               ztest_1 = 0 
    251249            ENDIF 
     
    258256               ztest_2 = 1 
    259257            ELSE 
    260               ! this write is useful 
    261               IF(lwp)  WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, & 
    262                             ' zvt_i_ini = ', zvt_i_ini(i_hemis) 
    263258               ztest_2 = 0 
    264259            ENDIF 
     
    268263               ztest_3 = 1 
    269264            ELSE 
    270                ! this write is useful 
    271                IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
    272                zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    273265               ztest_3 = 0 
    274266            ENDIF 
     
    278270            DO jl = 1, jpl 
    279271               IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN  
    280                   ! this write is useful 
    281                   IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(jl,i_hemis) 
    282272                  ztest_4 = 0 
    283273               ENDIF 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r6487 r7083  
    392392      INTEGER :: ji,jj,jn 
    393393      REAL(wp) :: zalpha 
    394       REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr  
    395394      !!-----------------------------------------------------------------------       
    396395      ! 
     
    529528            END DO 
    530529         END DO 
     530      ELSE 
     531         DO jj=MAX(j1,2),j2 
     532            DO ji=MAX(i1,2),i2 
     533               uice_agr(ji,jj) = tabres(ji,jj) 
     534            END DO 
     535         END DO 
    531536      ENDIF 
    532537#else 
     
    541546            END DO 
    542547         END DO 
     548      ELSE 
     549         DO jj= j1, j2 
     550            DO ji= i1, i2 
     551               uice_agr(ji,jj) = tabres(ji,jj) 
     552            END DO 
     553         END DO 
    543554      ENDIF 
    544555#endif 
     
    566577                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
    567578               ENDIF 
     579            END DO 
     580         END DO 
     581      ELSE 
     582         DO jj=MAX(j1,2),j2 
     583            DO ji=MAX(i1,2),i2 
     584               vice_agr(ji,jj) = tabres(ji,jj) 
    568585            END DO 
    569586         END DO 
     
    580597            END DO 
    581598         END DO 
     599      ELSE 
     600         DO jj= j1 ,j2 
     601            DO ji = i1, i2 
     602               vice_agr(ji,jj) = tabres(ji,jj) 
     603            END DO 
     604         END DO 
    582605      ENDIF 
    583606#endif 
     
    585608 
    586609 
    587    SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 
     610   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before ) 
    588611      !!----------------------------------------------------------------------- 
    589612      !!                    *** ROUTINE interp_adv_ice ***                            
     
    593616      !!              put -9999 where no ice for correct extrapolation              
    594617      !!----------------------------------------------------------------------- 
    595       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    596       REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 
     618      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     619      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    597620      LOGICAL, INTENT(in) :: before 
    598621      !! 
     
    601624      ! 
    602625      IF( before ) THEN 
    603          DO jj=j1,j2 
    604             DO ji=i1,i2 
    605                IF( tms(ji,jj) == 0. ) THEN 
    606                   tabres(ji,jj,:) = -9999.  
    607                ELSE 
    608                   tabres(ji,jj, 1) = frld  (ji,jj) 
    609                   tabres(ji,jj, 2) = hicif (ji,jj) 
    610                   tabres(ji,jj, 3) = hsnif (ji,jj) 
    611                   tabres(ji,jj, 4) = tbif  (ji,jj,1) 
    612                   tabres(ji,jj, 5) = tbif  (ji,jj,2) 
    613                   tabres(ji,jj, 6) = tbif  (ji,jj,3) 
    614                   tabres(ji,jj, 7) = qstoif(ji,jj) 
    615                ENDIF 
    616             END DO 
    617          END DO 
     626         DO jj=j1,j2 
     627       DO ji=i1,i2 
     628          IF( tms(ji,jj) == 0. ) THEN 
     629             tabres(ji,jj,:) = -9999  
     630          ELSE 
     631             tabres(ji,jj, 1) = frld  (ji,jj) 
     632             tabres(ji,jj, 2) = hicif (ji,jj) 
     633             tabres(ji,jj, 3) = hsnif (ji,jj) 
     634             tabres(ji,jj, 4) = tbif  (ji,jj,1) 
     635             tabres(ji,jj, 5) = tbif  (ji,jj,2) 
     636             tabres(ji,jj, 6) = tbif  (ji,jj,3) 
     637             tabres(ji,jj, 7) = qstoif(ji,jj) 
     638          ENDIF 
     639       END DO 
     640         END DO 
     641      ELSE 
     642    DO jj=j1,j2 
     643       DO ji=i1,i2 
     644               DO jk=k1, k2 
     645             tabice_agr(ji,jj,jk) = tabres(ji,jj,jk) 
     646               END DO 
     647       END DO 
     648    END DO 
    618649      ENDIF 
    619650      ! 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r6731 r7083  
    212212      REAL(wp) ::   zztmp   
    213213      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
    214       ! reading initial file 
    215       LOGICAL  ::   ln_tsd_init      !: T & S data flag 
    216       LOGICAL  ::   ln_tsd_tradmp    !: internal damping toward input data flag 
    217       CHARACTER(len=100)            ::   cn_dir 
    218       TYPE(FLD_N)                   ::  sn_tem,sn_sal 
    219       INTEGER  ::   ios=0 
    220  
    221       NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal 
    222       ! 
    223  
    224       REWIND( numnam_ref )              ! Namelist namtsd in reference namelist : 
    225       READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    226 901   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp ) 
    227       REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run 
    228       READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    229 902   IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp ) 
    230       IF(lwm) WRITE ( numond, namtsd ) 
    231214      ! 
    232215      !!---------------------------------------------------------------------- 
     
    234217      IF( nn_timing == 1 )   CALL timing_start('dia_ar5_init') 
    235218      ! 
    236       CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 
     219      CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta ) 
    237220      !                                      ! allocate dia_ar5 arrays 
    238221      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
     
    250233      IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    251234 
    252       CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 
    253       CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1  ) 
    254       CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 
     235      CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
     236      CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     237      CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
    255238      CALL iom_close( inum ) 
     239 
    256240      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    257241      sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     
    268252      ENDIF 
    269253      ! 
    270       CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 
     254      CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta ) 
    271255      ! 
    272256      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init') 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r6486 r7083  
    323323            ze3va =  ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl   * fse3v_a(ji,jj,1)  
    324324            va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    325                &                                      / ( ze3va * rau0 )  
     325               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1) 
    326326#else 
    327327            va(ji,jj,1) = vb(ji,jj,1) & 
    328328               &                   + p2dt *(va(ji,jj,1) +  0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    329                &                                                       / ( fse3v(ji,jj,1) * rau0     ) ) 
     329               &                                      / ( fse3v(ji,jj,1) * rau0     ) * vmask(ji,jj,1) ) 
    330330#endif 
    331331         END DO 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r6486 r7083  
    120120      ! first entry with narea for this processor is left hand interior index 
    121121      ! last  entry                               is right hand interior index 
    122       jj = jpj/2 
     122      jj = nlcj/2 
    123123      nicbdi = -1 
    124124      nicbei = -1 
     
    136136      ! 
    137137      ! repeat for j direction 
    138       ji = jpi/2 
     138      ji = nlci/2 
    139139      nicbdj = -1 
    140140      nicbej = -1 
     
    153153      ! special for east-west boundary exchange we save the destination index 
    154154      i1 = MAX( nicbdi-1, 1) 
    155       i3 = INT( src_calving(i1,jpj/2) ) 
     155      i3 = INT( src_calving(i1,nlcj/2) ) 
    156156      jj = INT( i3/nicbpack ) 
    157157      ricb_left = REAL( i3 - nicbpack*jj, wp ) 
    158158      i1 = MIN( nicbei+1, jpi ) 
    159       i3 = INT( src_calving(i1,jpj/2) ) 
     159      i3 = INT( src_calving(i1,nlcj/2) ) 
    160160      jj = INT( i3/nicbpack ) 
    161161      ricb_right = REAL( i3 - nicbpack*jj, wp ) 
     
    196196         WRITE(numicb,*) 'berg left       ', ricb_left 
    197197         WRITE(numicb,*) 'berg right      ', ricb_right 
    198          jj = jpj/2 
     198         jj = nlcj/2 
    199199         WRITE(numicb,*) "central j line:" 
    200200         WRITE(numicb,*) "i processor" 
     
    202202         WRITE(numicb,*) "i point" 
    203203         WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 
    204          ji = jpi/2 
     204         ji = nlci/2 
    205205         WRITE(numicb,*) "central i line:" 
    206206         WRITE(numicb,*) "j processor" 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r6486 r7083  
    157157         END DO 
    158158      ENDIF 
     159 
     160      ! ORCA R1: Take the minimum between aeiw  and aeiv0 
     161      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN 
     162         DO jj = 2, jpjm1 
     163            DO ji = fs_2, fs_jpim1   ! vector opt. 
     164               aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 
     165            END DO 
     166         END DO 
     167      ENDIF 
     168 
    159169      CALL lbc_lnk( aeiw, 'W', 1. )      ! lateral boundary condition on aeiw  
    160170 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r6498 r7083  
    206206      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    207207         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1)  
    208          qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1) 
     208         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     209         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1) 
     210         ENDIF 
    209211         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1)          
    210212         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7033 r7083  
    16181618      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
    16191619      !! 
    1620       !! ** Purpose :   provide the heat and freshwater fluxes of the  
    1621       !!              ocean-ice system. 
     1620      !! ** Purpose :   provide the heat and freshwater fluxes of the ocean-ice system 
    16221621      !! 
    16231622      !! ** Method  :   transform the fields received from the atmosphere into 
    16241623      !!             surface heat and fresh water boundary condition for the  
    16251624      !!             ice-ocean system. The following fields are provided: 
    1626       !!              * total non solar, solar and freshwater fluxes (qns_tot,  
     1625      !!               * total non solar, solar and freshwater fluxes (qns_tot,  
    16271626      !!             qsr_tot and emp_tot) (total means weighted ice-ocean flux) 
    16281627      !!             NB: emp_tot include runoffs and calving. 
    1629       !!              * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 
     1628      !!               * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 
    16301629      !!             emp_ice = sublimation - solid precipitation as liquid 
    16311630      !!             precipitation are re-routed directly to the ocean and  
    1632       !!             runoffs and calving directly enter the ocean. 
    1633       !!              * solid precipitation (sprecip), used to add to qns_tot  
     1631      !!             calving directly enter the ocean (runoffs are read but included in trasbc.F90) 
     1632      !!               * solid precipitation (sprecip), used to add to qns_tot  
    16341633      !!             the heat lost associated to melting solid precipitation 
    16351634      !!             over the ocean fraction. 
    1636       !!       ===>> CAUTION here this changes the net heat flux received from 
    1637       !!             the atmosphere 
    1638       !! 
    1639       !!                  - the fluxes have been separated from the stress as 
    1640       !!                 (a) they are updated at each ice time step compare to 
    1641       !!                 an update at each coupled time step for the stress, and 
    1642       !!                 (b) the conservative computation of the fluxes over the 
    1643       !!                 sea-ice area requires the knowledge of the ice fraction 
    1644       !!                 after the ice advection and before the ice thermodynamics, 
    1645       !!                 so that the stress is updated before the ice dynamics 
    1646       !!                 while the fluxes are updated after it. 
     1635      !!               * heat content of rain, snow and evap can also be provided, 
     1636      !!             otherwise heat flux associated with these mass flux are 
     1637      !!             guessed (qemp_oce, qemp_ice) 
     1638      !! 
     1639      !!             - the fluxes have been separated from the stress as 
     1640      !!               (a) they are updated at each ice time step compare to 
     1641      !!               an update at each coupled time step for the stress, and 
     1642      !!               (b) the conservative computation of the fluxes over the 
     1643      !!               sea-ice area requires the knowledge of the ice fraction 
     1644      !!               after the ice advection and before the ice thermodynamics, 
     1645      !!               so that the stress is updated before the ice dynamics 
     1646      !!               while the fluxes are updated after it. 
     1647      !! 
     1648      !! ** Details 
     1649      !!             qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice   => provided 
     1650      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns 
     1651      !! 
     1652      !!             qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice   => provided 
     1653      !! 
     1654      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce) 
     1655      !!                                                                      river runoff (rnf) is provided but not included here 
    16471656      !! 
    16481657      !! ** Action  :   update at each nf_ice time step: 
    16491658      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes 
    16501659      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice 
    1651       !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
    1652       !!                   emp_ice            ice sublimation - solid precipitation over the ice 
    1653       !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
    1654       !!                   sprecip             solid precipitation over the ocean   
     1660      !!                   emp_tot           total evaporation - precipitation(liquid and solid) (-calving) 
     1661      !!                   emp_ice           ice sublimation - solid precipitation over the ice 
     1662      !!                   dqns_ice          d(non-solar heat flux)/d(Temperature) over the ice 
     1663      !!                   sprecip           solid precipitation over the ocean   
    16551664      !!---------------------------------------------------------------------- 
    16561665      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
     
    16621671      INTEGER ::   jl         ! dummy loop index 
    16631672      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, ztmp, zicefr, zmsk, zsnw 
    1664       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice 
     1673      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 
    16651674      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
    16661675      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 
     
    16701679      ! 
    16711680      CALL wrk_alloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
    1672       CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 
     1681      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    16731682      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
    16741683      CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 
     
    16791688      ! 
    16801689      !                                                      ! ========================= ! 
    1681       !                                                      !    freshwater budget      !   (emp) 
     1690      !                                                      !    freshwater budget      !   (emp_tot) 
    16821691      !                                                      ! ========================= ! 
    16831692      ! 
    1684       !                                                           ! total Precipitation - total Evaporation (emp_tot) 
    1685       !                                                           ! solid precipitation - sublimation       (emp_ice) 
    1686       !                                                           ! solid Precipitation                     (sprecip) 
    1687       !                                                           ! liquid + solid Precipitation            (tprecip) 
     1693      !                                                           ! solid Precipitation                                (sprecip) 
     1694      !                                                           ! liquid + solid Precipitation                       (tprecip) 
     1695      !                                                           ! total Evaporation - total Precipitation            (emp_tot) 
     1696      !                                                           ! sublimation - solid precipitation (cell average)   (emp_ice) 
    16881697      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    16891698      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
     
    17171726         ENDIF 
    17181727#else          
    1719          zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1728         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 
    17201729#endif                   
    17211730         CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1)      )   ! liquid precipitation  
     
    17331742      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    17341743         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1735          zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1744         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 
    17361745         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    17371746         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
     
    17391748 
    17401749#if defined key_lim3 
    1741       ! zsnw = snow percentage over ice after wind blowing 
    1742       zsnw(:,:) = 0._wp 
    1743       CALL lim_thd_snwblow( p_frld, zsnw ) 
     1750      ! zsnw = snow fraction over ice after wind blowing 
     1751      zsnw(:,:) = 0._wp  ;  CALL lim_thd_snwblow( p_frld, zsnw ) 
    17441752       
    1745       ! --- evaporation (kg/m2/s) --- ! 
     1753      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 
     1754      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip 
     1755      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice 
     1756 
     1757      ! --- evaporation over ocean (used later for qemp) --- ! 
     1758      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
     1759 
     1760      ! --- evaporation over ice (kg/m2/s) --- ! 
    17461761      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 
    17471762      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     
    17491764      zdevap_ice(:,:) = 0._wp 
    17501765       
    1751       ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 
    1752       zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 
    1753       zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)           
    1754  
    1755       ! Sublimation over sea-ice (cell average) 
    1756       IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 
    1757       ! runoffs and calving (put in emp_tot) 
     1766      ! --- runoffs (included in emp later on) --- ! 
    17581767      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1768 
     1769      ! --- calving (put in emp_tot and emp_oce) --- ! 
    17591770      IF( srcv(jpr_cal)%laction ) THEN  
    17601771         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1772         zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    17611773         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
    17621774      ENDIF 
     
    17841796      ENDIF 
    17851797 
    1786                                      CALL iom_put( 'snowpre'    , sprecip                         )  ! Snow 
    1787       IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) )  ! Snow over ice-free ocean  (cell average) 
    1788       IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea', sprecip(:,:) *           zsnw   )  ! Snow over sea-ice         (cell average)     
     1798      IF( iom_use('subl_ai_cea') )   CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:)         )  ! Sublimation over sea-ice (cell average) 
     1799                                     CALL iom_put( 'snowpre'    , sprecip(:,:)                         )  ! Snow 
     1800      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) )  ! Snow over ice-free ocean  (cell average) 
     1801      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea', sprecip(:,:) *           zsnw(:,:)   )  ! Snow over sea-ice         (cell average) 
    17891802#else 
    1790       ! Sublimation over sea-ice (cell average) 
    1791       IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 
    17921803      ! runoffs and calving (put in emp_tot) 
    17931804      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     
    18211832      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns) 
    18221833      !                                                      ! ========================= ! 
    1823       CASE( 'oce only' )                                     ! the required field is directly provided 
    1824          zqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    1825       CASE( 'conservative' )                                      ! the required fields are directly provided 
    1826          zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1834      CASE( 'oce only' )         ! the required field is directly provided 
     1835         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1836      CASE( 'conservative' )     ! the required fields are directly provided 
     1837         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    18271838         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    18281839            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    18291840         ELSE 
    1830             ! Set all category values equal for the moment 
    18311841            DO jl=1,jpl 
    1832                zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1842               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 
    18331843            ENDDO 
    18341844         ENDIF 
    1835       CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1836          zqns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1845      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes 
     1846         zqns_tot(:,:) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    18371847         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    18381848            DO jl=1,jpl 
     
    18411851            ENDDO 
    18421852         ELSE 
    1843             qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1853            qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    18441854            DO jl=1,jpl 
    18451855               zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     
    18471857            ENDDO 
    18481858         ENDIF 
    1849       CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
     1859      CASE( 'mixed oce-ice' )    ! the ice flux is cumputed from the total flux, the SST and ice informations 
    18501860! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    18511861         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    18521862         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    18531863            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    1854             &                                                   +          pist(:,:,1)  * zicefr(:,:) ) ) 
     1864            &                                           + pist(:,:,1) * zicefr(:,:) ) ) 
    18551865      END SELECT 
    18561866!!gm 
     
    18621872!! similar job should be done for snow and precipitation temperature 
    18631873      !                                      
    1864       IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    1865          ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1866          zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 
    1867          IF( iom_use('hflx_cal_cea') )   & 
    1868             CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    1869       ENDIF 
    1870  
    1871       ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 
    1872       IF( iom_use('hflx_snow_cea') )    CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1874      IF( srcv(jpr_cal)%laction ) THEN   ! Iceberg melting  
     1875         zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus  ! add the latent heat of iceberg melting 
     1876                                                                         ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 
     1877         IF( iom_use('hflx_cal_cea') )   CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus )   ! heat flux from calving 
     1878      ENDIF 
    18731879 
    18741880#if defined key_lim3       
    1875       ! --- evaporation --- ! 
    1876       zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 
    1877  
    18781881      ! --- non solar flux over ocean --- ! 
    18791882      !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     
    18821885 
    18831886      ! --- heat flux associated with emp (W/m2) --- ! 
    1884       zqemp_oce(:,:) = -      zevap(:,:)                   * p_frld(:,:)      *   zcptn(:,:)   &      ! evap 
    1885          &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &      ! liquid precip 
    1886          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 
     1887      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn(:,:)   &       ! evap 
     1888         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &       ! liquid precip 
     1889         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus )  ! solid precip over ocean + snow melting 
    18871890!      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
    18881891!         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
    18891892      zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 
    1890                                                                                                        ! qevap_ice=0 since we consider Tice=0°C 
     1893                                                                                                       ! qevap_ice=0 since we consider Tice=0degC 
    18911894       
    1892       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     1895      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    18931896      zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
    18941897 
    18951898      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
    18961899      DO jl = 1, jpl 
    1897          zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0°C 
     1900         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 
    18981901      END DO 
    18991902 
     
    19211924         qemp_ice (:,:  ) = zqemp_ice (:,:  ) 
    19221925      ENDIF 
     1926 
     1927      !! clem: we should output qemp_oce and qemp_ice (at least) 
     1928      IF( iom_use('hflx_snow_cea') )   CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) )   ! heat flux from snow (cell average) 
     1929      !! these diags are not outputed yet 
     1930!!      IF( iom_use('hflx_rain_cea') )   CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) )   ! heat flux from rain (cell average) 
     1931!!      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 
     1932!!      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 
     1933 
    19231934#else 
    19241935      ! clem: this formulation is certainly wrong... but better than it was... 
     
    19271938         &          - (p_frld(:,:) * zsprecip(:,:) * lfus)  &          ! remove the latent heat flux of solid precip. melting 
    19281939         &          - (  zemp_tot(:,:)                    &            ! remove the heat content of mass flux (assumed to be at SST) 
    1929          &             - zemp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
     1940         &             - zemp_ice(:,:) ) * zcptn(:,:)  
    19301941 
    19311942     IF( ln_mixcpl ) THEN 
     
    20472058 
    20482059      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
    2049       CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap, zevap_ice, zdevap_ice ) 
     2060      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    20502061      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
    20512062      CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6498 r7083  
    10181018         DO jj = 1, jpj 
    10191019            DO ji = 1, jpi 
    1020                zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 )           ! square root salinity 
     1020               zs= SQRT( ABS( psal(ji,jj) ) / 35.16504_wp )           ! square root salinity 
    10211021               ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
    10221022                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
     
    10661066      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
    10671067         ! 
    1068          zs  = SQRT( ABS( psal ) * r1_S0 )           ! square root salinity 
     1068         zs  = SQRT( ABS( psal ) / 35.16504_wp )           ! square root salinity 
    10691069         ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 
    10701070                  &          - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

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

    r6919 r7083  
    7979# endif   
    8080      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
    81       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d 
     81      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 
    8282      !!---------------------------------------------------------------------- 
    8383      ! 
     
    8686# if defined key_diaeiv  
    8787      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
    88       IF( ln_diaptr ) CALL wrk_alloc( jpi, jpj, jpk, z3d ) 
     88      CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 
    8989# else 
    9090      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
     
    170170           CALL iom_put( "weiv_masstr" , z3d )   
    171171         ENDIF 
    172          IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") ) THEN 
     172         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d')        & 
     173                                    .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 
    173174            z3d(:,:,jpk) = 0.e0 
    174             z2d(:,:) = 0.e0 
    175175            DO jk = 1, jpkm1 
    176176               z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
    177                z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    178177            END DO 
    179178            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
    180179         ENDIF 
    181180 
    182          IF( iom_use('ueiv_heattr') ) THEN 
     181         IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    183182            zztmp = 0.5 * rcp  
    184183            z2d(:,:) = 0.e0  
    185             DO jk = 1, jpkm1 
    186                DO jj = 2, jpjm1 
    187                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    188                      z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    189                   END DO 
    190                END DO 
    191             END DO 
    192             CALL lbc_lnk( z2d, 'U', -1. ) 
    193             CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
    194          ENDIF 
    195  
    196          IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") ) THEN 
     184            z3d_T(:,:,:) = 0.e0  
     185            DO jk = 1, jpkm1 
     186               DO jj = 2, jpjm1 
     187                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     188                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     189                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     190                  END DO 
     191               END DO 
     192            END DO 
     193            IF (iom_use('ueiv_heattr') ) THEN 
     194               CALL lbc_lnk( z2d, 'U', -1. ) 
     195               CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! 2D heat transport in i-direction 
     196            ENDIF 
     197            IF (iom_use('ueiv_heattr3d') ) THEN 
     198               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     199               CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in i-direction 
     200            ENDIF 
     201         ENDIF 
     202 
     203         IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 
     204            zztmp = 0.5 * 0.001 
     205            z2d(:,:) = 0.e0  
     206            z3d_T(:,:,:) = 0.e0  
     207            DO jk = 1, jpkm1 
     208               DO jj = 2, jpjm1 
     209                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     210                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
     211                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     212                  END DO 
     213               END DO 
     214            END DO 
     215            IF (iom_use('ueiv_salttr') ) THEN 
     216               CALL lbc_lnk( z2d, 'U', -1. ) 
     217               CALL iom_put( "ueiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     218            ENDIF 
     219            IF (iom_use('ueiv_salttr3d') ) THEN 
     220               CALL lbc_lnk( z3d_T, 'U', -1. ) 
     221               CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     222            ENDIF 
     223         ENDIF 
     224 
     225         IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d')       & 
     226                                    .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 
    197227            z3d(:,:,jpk) = 0.e0 
    198             z2d(:,:) = 0.e0 
    199228            DO jk = 1, jpkm1 
    200229               z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     
    202231            CALL iom_put( "veiv_masstr", z3d )                  ! mass transport in j-direction 
    203232         ENDIF 
    204              
    205          IF( iom_use('veiv_heattr') ) THEN 
     233         IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 
    206234            zztmp = 0.5 * rcp  
    207235            z2d(:,:) = 0.e0  
    208             DO jk = 1, jpkm1 
    209                DO jj = 2, jpjm1 
    210                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    211                      z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    212                   END DO 
    213                END DO 
    214             END DO 
    215             CALL lbc_lnk( z2d, 'V', -1. ) 
    216             CALL iom_put( "veiv_heattr", zztmp * z2d )                  !  heat transport in j-direction 
    217          ENDIF 
     236            z3d_T(:,:,:) = 0.e0  
     237            DO jk = 1, jpkm1 
     238               DO jj = 2, jpjm1 
     239                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     240                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     241                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk)  
     242                  END DO 
     243               END DO 
     244            END DO 
     245            IF (iom_use('veiv_heattr') ) THEN 
     246               CALL lbc_lnk( z2d, 'V', -1. ) 
     247               CALL iom_put( "veiv_heattr", zztmp * z2d )                  ! 2D heat transport in j-direction 
     248            ENDIF 
     249            IF (iom_use('veiv_heattr3d') ) THEN 
     250               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     251               CALL iom_put( "veiv_heattr3d", zztmp * z3d_T )              ! 3D heat transport in j-direction 
     252            ENDIF 
     253         ENDIF 
     254 
     255         IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 
     256            zztmp = 0.5 * 0.001 
     257            z2d(:,:) = 0.e0  
     258            z3d_T(:,:,:) = 0.e0  
     259            DO jk = 1, jpkm1 
     260               DO jj = 2, jpjm1 
     261                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     262                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     263                     z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 
     264                  END DO 
     265               END DO 
     266            END DO 
     267            IF (iom_use('veiv_salttr') ) THEN 
     268               CALL lbc_lnk( z2d, 'V', -1. ) 
     269               CALL iom_put( "veiv_salttr", zztmp * z2d )                  ! 2D salt transport in i-direction 
     270            ENDIF 
     271            IF (iom_use('veiv_salttr3d') ) THEN 
     272               CALL lbc_lnk( z3d_T, 'V', -1. ) 
     273               CALL iom_put( "veiv_salttr3d", zztmp * z3d_T )              ! 3D salt transport in i-direction 
     274            ENDIF 
     275         ENDIF 
     276 
     277         IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN   ! vertical mass transport & its square value 
     278           z2d(:,:) = rau0 * e12t(:,:) 
     279           DO jk = 1, jpk 
     280              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     281           END DO 
     282           CALL iom_put( "weiv_masstr" , z3d )                  ! mass transport in k-direction 
     283         ENDIF 
     284 
     285         IF( iom_use('weiv_heattr3d') ) THEN 
     286            zztmp = 0.5 * rcp  
     287            DO jk = 1, jpkm1 
     288               DO jj = 2, jpjm1 
     289                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     290                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 
     291                  END DO 
     292               END DO 
     293            END DO 
     294            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     295            CALL iom_put( "weiv_heattr3d", zztmp * z3d_T )                 ! 3D heat transport in k-direction 
     296         ENDIF 
     297 
     298         IF( iom_use('weiv_salttr3d') ) THEN 
     299            zztmp = 0.5 * 0.001  
     300            DO jk = 1, jpkm1 
     301               DO jj = 2, jpjm1 
     302                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     303                     z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 
     304                  END DO 
     305               END DO 
     306            END DO 
     307            CALL lbc_lnk( z3d_T, 'T', 1. ) 
     308            CALL iom_put( "weiv_salttr3d", zztmp * z3d_T )                 ! 3D salt transport in k-direction 
     309         ENDIF 
     310 
    218311    END IF 
    219312! 
     
    244337# if defined key_diaeiv  
    245338      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
    246       IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 
     339      CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 
    247340# else 
    248341      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6731 r7083  
    184184            DO jj = 2, jpjm1 
    185185               DO ji = fs_2, fs_jpim1   ! vector opt. 
    186                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    187186                  ! total intermediate advective trends 
    188                   ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    189                      &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    190                      &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
     187                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     188                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
     189                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / e1e2t(ji,jj) 
    191190                  ! update and guess with monotonic sheme 
    192                   pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra  * tmask(ji,jj,jk) 
    193                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk) 
     191                  pta(ji,jj,jk,jn) =                       pta(ji,jj,jk,jn) +         ztra   / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     192                  zwi(ji,jj,jk)    = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    194193               END DO 
    195194            END DO 
     
    454453            DO jj = 2, jpjm1 
    455454               DO ji = fs_2, fs_jpim1   ! vector opt. 
    456                   zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    457455                  ! total intermediate advective trends 
    458                   ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    459                      &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    460                      &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
     456                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     457                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
     458                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) / e1e2t(ji,jj) 
    461459                  ! update and guess with monotonic sheme 
    462                   pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
    463                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk) 
     460                  pta(ji,jj,jk,jn) =                       pta(ji,jj,jk,jn) +         ztra   / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     461                  zwi(ji,jj,jk)    = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    464462               END DO 
    465463            END DO 
     
    479477         ! -------------------------------------------------- 
    480478         ! antidiffusive flux on i and j 
    481  
    482  
     479         ! 
    483480         DO jk = 1, jpkm1 
    484  
     481            ! 
    485482            DO jj = 1, jpjm1 
    486483               DO ji = 1, fs_jpim1   ! vector opt. 
     
    513510         ! 
    514511         ztrs(:,:,:,1) = ptb(:,:,:,jn) 
     512         ztrs(:,:,1,2) = ptb(:,:,1,jn) 
     513         ztrs(:,:,1,3) = ptb(:,:,1,jn) 
    515514         zwzts(:,:,:) = 0._wp 
    516515 
     
    614613   END SUBROUTINE tra_adv_tvd_zts 
    615614 
     615 
    616616   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
    617617      !!--------------------------------------------------------------------- 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r6731 r7083  
    2626   USE ldfslp          ! iso-neutral slopes 
    2727   USE diaptr          ! poleward transport diagnostics 
     28   USE trd_oce         ! trends: ocean variables 
     29   USE trdtra          ! trends manager: tracers  
    2830   USE in_out_manager  ! I/O manager 
    2931   USE iom             ! I/O library 
     
    105107      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    106108      INTEGER  ::  ikt 
    107       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    108       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    109       REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
     109      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3       ! local scalars 
     110      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4       !   -      - 
     111      REAL(wp) ::  zcoef0, zbtr                      !   -      - 
    110112      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    111113      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
     114      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  ztrax, ztray, ztraz  
     115      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::  ztrax_T, ztray_T, ztraz_T 
    112116      !!---------------------------------------------------------------------- 
    113117      ! 
     
    115119      ! 
    116120      CALL wrk_alloc( jpi, jpj,      z2d )  
    117       CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
     121      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t)  
     122      ALLOCATE( ztrax(jpi,jpj,jpk), ztray(jpi,jpj,jpk), ztraz(jpi,jpj,jpk) )  
     123      IF( l_trdtra .and. cdtype == 'TRA' ) ALLOCATE( ztrax_T(jpi,jpj,jpk), ztray_T(jpi,jpj,jpk), ztraz_T(jpi,jpj,jpk) )  
    118124      ! 
    119125 
     
    127133      DO jn = 1, kjpt                                            ! tracer loop 
    128134         !                                                       ! =========== 
     135         ztrax(:,:,:) = 0._wp ; ztray(:,:,:) = 0._wp ; ztraz(:,:,:) = 0._wp ;  
    129136         !                                                
    130137         !!---------------------------------------------------------------------- 
     
    226233               DO ji = fs_2, fs_jpim1   ! vector opt. 
    227234                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    228                   ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 
    229                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     235                  ztrax(ji,jj,jk) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) ) 
     236                  ztray(ji,jj,jk) = zbtr * ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 
    230237               END DO 
    231238            END DO 
     
    233240         END DO                                        !   End of slab   
    234241         !                                             ! =============== 
     242         ! 
     243         pta(:,:,:,jn) = pta(:,:,:,jn) + ztrax(:,:,:) + ztray(:,:,:) 
    235244         ! 
    236245         ! "Poleward" diffusive heat or salt transports (T-S case only) 
     
    311320               DO ji = fs_2, fs_jpim1   ! vector opt. 
    312321                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 
    313                   ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    314                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     322                  ztraz(ji,jj,jk) = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr 
    315323               END DO 
    316324            END DO 
    317325         END DO 
     326         pta(:,:,:,jn) = pta(:,:,:,jn) + ztraz(:,:,:) 
    318327         ! 
     328         IF( l_trdtra .AND. cdtype == "TRA" .AND. jn .eq. 1 )  THEN      ! save the temperature trends 
     329            ztrax_T(:,:,:) = ztrax(:,:,:) 
     330            ztray_T(:,:,:) = ztray(:,:,:) 
     331            ztraz_T(:,:,:) = ztraz(:,:,:) 
     332         ENDIF 
     333         IF( l_trdtra .AND. cdtype == "TRC" )   THEN      ! save the horizontal component of diffusive trends for further diagnostics 
     334            CALL trd_tra( kt, cdtype, jn, jptra_iso_x, ztrax ) 
     335            CALL trd_tra( kt, cdtype, jn, jptra_iso_y, ztray )  
     336            CALL trd_tra( kt, cdtype, jn, jptra_iso_z1, ztraz )  ! This is the first part of the vertical component. 
     337         ENDIF 
    319338      END DO 
     339      ! 
     340      IF( l_trdtra .AND. cdtype == "TRA" )   THEN      ! save the horizontal component of diffusive trends for further diagnostics 
     341         CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_x, ztrax_T ) 
     342         CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_x, ztrax ) 
     343         CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_y, ztray_T ) 
     344         CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_y, ztray ) 
     345         CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_z1, ztraz_T )  ! This is the first part of the vertical component 
     346         CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_z1, ztraz )    ! 
     347      ENDIF 
    320348      ! 
    321349      CALL wrk_dealloc( jpi, jpj, z2d )  
    322350      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
     351      DEALLOCATE( ztrax, ztray, ztraz )  
     352      IF( l_trdtra ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T )  
    323353      ! 
    324354      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r6487 r7083  
    129129      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter 
    130130         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     131         ! Asselin filter trend 
    131132         ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    132133         ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     
    135136            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
    136137         ENDIF 
     138         ! total trend (note slightly inaccurate because tsb is time-filtered and tsa isn't) 
     139         ztrdt(:,:,:) = 0._wp 
     140         ztrds(:,:,:) = 0._wp 
     141         DO jk = 1, jpkm1 
     142            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk)  
     143            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk)  
     144         END DO 
     145         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
     146         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 
    137147      ENDIF 
    138148 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r6487 r7083  
    158158         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    159159            zfact = 1._wp 
     160            sbc_tsc(:,:,:) = 0._wp 
    160161            sbc_tsc_b(:,:,:) = 0._wp 
    161162         ENDIF 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90

    r6486 r7083  
    3333# endif 
    3434   !                                                  !!!* Active tracers trends indexes 
    35    INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 14     !: Total trend nb: change it when adding/removing one indice below 
     35   INTEGER, PUBLIC, PARAMETER ::   jptot_tra  = 20     !: Total trend nb: change it when adding/removing one indice below 
    3636   !                               ===============     !   
    3737   INTEGER, PUBLIC, PARAMETER ::   jptra_xad  =  1     !: x- horizontal advection 
     
    3939   INTEGER, PUBLIC, PARAMETER ::   jptra_zad  =  3     !: z- vertical   advection 
    4040   INTEGER, PUBLIC, PARAMETER ::   jptra_sad  =  4     !: z- vertical   advection 
    41    INTEGER, PUBLIC, PARAMETER ::   jptra_ldf  =  5     !: lateral       diffusion 
    42    INTEGER, PUBLIC, PARAMETER ::   jptra_zdf  =  6     !: vertical      diffusion 
    43    INTEGER, PUBLIC, PARAMETER ::   jptra_zdfp =  7     !: "PURE" vert.  diffusion (ln_traldf_iso=T) 
    44    INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  =  8     !: Bottom Boundary Condition (geoth. heating)  
    45    INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  =  9     !: Bottom Boundary Layer (diffusive and/or advective) 
    46    INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 10     !: non-penetrative convection treatment 
    47    INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 11     !: internal restoring (damping) 
    48    INTEGER, PUBLIC, PARAMETER ::   jptra_qsr  = 12     !: penetrative solar radiation 
    49    INTEGER, PUBLIC, PARAMETER ::   jptra_nsr  = 13     !: non solar radiation / C/D on salinity  (+runoff if ln_rnf=T) 
    50    INTEGER, PUBLIC, PARAMETER ::   jptra_atf  = 14     !: Asselin time filter 
     41   INTEGER, PUBLIC, PARAMETER ::   jptra_totad  =  5   !: total         advection 
     42   INTEGER, PUBLIC, PARAMETER ::   jptra_ldf  =  6     !: lateral       diffusion 
     43   INTEGER, PUBLIC, PARAMETER ::   jptra_iso_x  =  7   !: x-component of isopycnal diffusion 
     44   INTEGER, PUBLIC, PARAMETER ::   jptra_iso_y  =  8   !: y-component of isopycnal diffusion 
     45   INTEGER, PUBLIC, PARAMETER ::   jptra_iso_z1 =  9   !: z-component of isopycnal diffusion 
     46   INTEGER, PUBLIC, PARAMETER ::   jptra_zdf  = 10     !: vertical      diffusion 
     47   INTEGER, PUBLIC, PARAMETER ::   jptra_zdfp = 11     !: "PURE" vert.  diffusion (ln_traldf_iso=T) 
     48   INTEGER, PUBLIC, PARAMETER ::   jptra_evd  = 12     !: EVD term (convection) 
     49   INTEGER, PUBLIC, PARAMETER ::   jptra_bbc  = 13     !: Bottom Boundary Condition (geoth. heating)  
     50   INTEGER, PUBLIC, PARAMETER ::   jptra_bbl  = 14     !: Bottom Boundary Layer (diffusive and/or advective) 
     51   INTEGER, PUBLIC, PARAMETER ::   jptra_npc  = 15     !: non-penetrative convection treatment 
     52   INTEGER, PUBLIC, PARAMETER ::   jptra_dmp  = 16     !: internal restoring (damping) 
     53   INTEGER, PUBLIC, PARAMETER ::   jptra_qsr  = 17     !: penetrative solar radiation 
     54   INTEGER, PUBLIC, PARAMETER ::   jptra_nsr  = 18     !: non solar radiation / C/D on salinity  (+runoff if ln_rnf=T) 
     55   INTEGER, PUBLIC, PARAMETER ::   jptra_atf  = 19     !: Asselin time filter 
     56   INTEGER, PUBLIC, PARAMETER ::   jptra_tot  = 20     !: Model total trend 
    5157   ! 
    5258   !                                                  !!!* Passive tracers trends indices (use if "key_top" defined) 
    53    INTEGER, PUBLIC, PARAMETER ::   jptra_sms  = 15     !: sources m. sinks 
    54    INTEGER, PUBLIC, PARAMETER ::   jptra_radn = 16     !: corr. trn<0 in trcrad 
    55    INTEGER, PUBLIC, PARAMETER ::   jptra_radb = 17     !: corr. trb<0 in trcrad (like atf) 
     59   INTEGER, PUBLIC, PARAMETER ::   jptra_sms  = 19     !: sources m. sinks 
     60   INTEGER, PUBLIC, PARAMETER ::   jptra_radn = 20     !: corr. trn<0 in trcrad 
     61   INTEGER, PUBLIC, PARAMETER ::   jptra_radb = 21     !: corr. trb<0 in trcrad (like atf) 
    5662   ! 
    5763   !                                                  !!!* Momentum trends indices 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r6486 r7083  
    9191!!gm end 
    9292      ! 
    93       IF( lk_vvl .AND. ( l_trdtra .OR. l_trddyn ) )  CALL ctl_stop( 'trend diagnostics with variable volume not validated' ) 
    9493       
    9594!!gm  : Potential BUG : 3D output only for vector invariant form!  add a ctl_stop or code the flux form case 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r6486 r7083  
    3838   REAL(wp) ::   r2dt   ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    3939 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt   ! use to store the temperature trends 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   trdtx, trdty, trdt  ! use to store the temperature trends 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_evd  ! store avt_evd to calculate EVD trend 
    4142 
    4243   !! * Substitutions 
     
    5556      !!                  ***  FUNCTION trd_tra_alloc  *** 
    5657      !!--------------------------------------------------------------------- 
    57       ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
     58      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc ) 
    5859      ! 
    5960      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc ) 
     
    104105                                 ztrds(:,:,:) = 0._wp 
    105106                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     107         CASE( jptra_evd )   ;   avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    106108         CASE DEFAULT                 ! other trends: masked trends 
    107109            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store 
     
    138140            END DO 
    139141            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     142            ! 
     143            !                         ! Also calculate EVD trend at this point.  
     144            zwt(:,:,:) = 0._wp   ;   zws(:,:,:) = 0._wp            ! vertical diffusive fluxes 
     145            DO jk = 2, jpk 
     146               zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     147               zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     148            END DO 
     149            ! 
     150            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
     151            DO jk = 1, jpkm1 
     152               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
     153               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
     154            END DO 
     155            CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )   
    140156            ! 
    141157            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     
    312328                                  CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
    313329                               ENDIF 
     330      CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )        ! total   advection 
     331                               CALL iom_put( "strd_totad" , ptrdy ) 
    314332      CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
    315333                               CALL iom_put( "strd_ldf" , ptrdy ) 
     
    318336      CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
    319337                               CALL iom_put( "strd_zdfp", ptrdy ) 
     338      CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection) 
     339                               CALL iom_put( "strd_evd", ptrdy ) 
     340      CASE( jptra_iso_x )  ;   CALL iom_put( "ttrd_iso_x", ptrdx )       ! x-component of isopycnal mixing 
     341                               CALL iom_put( "strd_iso_x", ptrdy ) 
     342      CASE( jptra_iso_y )  ;   CALL iom_put( "ttrd_iso_y", ptrdx )       ! y-component of isopycnal mixing 
     343                               CALL iom_put( "strd_iso_y", ptrdy ) 
     344      CASE( jptra_iso_z1 ) ;   CALL iom_put( "ttrd_iso_z1", ptrdx )      ! first part of z-component of isopycnal mixing 
     345                               CALL iom_put( "strd_iso_z1", ptrdy ) 
    320346      CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
    321347                               CALL iom_put( "strd_dmp" , ptrdy ) 
     
    330356      CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
    331357                               CALL iom_put( "strd_atf" , ptrdy ) 
     358      CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )        ! model total trend 
     359                               CALL iom_put( "strd_tot" , ptrdy ) 
    332360      END SELECT 
    333361      ! 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r6486 r7083  
    1919   USE zdf_oce         ! ocean vertical physics variables 
    2020   USE zdfkpp          ! KPP vertical mixing 
     21   USE trd_oce         ! trends: ocean variables 
     22   USE trdtra          ! trends manager: tracers  
    2123   USE in_out_manager  ! I/O manager 
    2224   USE iom             ! for iom_put 
     
    122124      zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    123125      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     126      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    124127      ! 
    125128      IF( nn_timing == 1 )  CALL timing_stop('zdf_evd') 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r6698 r7083  
    140140                   PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj),     STAT=ierr(5) ) 
    141141 
    142          ! RSRH Temporarily initialise output coupling fields while we await clarification 
    143          ! of exactly how these will be initialised at model startup! 
    144          DMS_out_cpl(:,:) = 0.0 
    145          CO2Flux_out_cpl(:,:) = 0.0 
    146142      ENDIF 
    147143#endif 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r6618 r7083  
    7676      REAL(wp) ::   zchl 
    7777      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    78       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 
     78      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 
     79      REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr 
    7980      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 
    8081      !!--------------------------------------------------------------------- 
     
    8384      ! 
    8485      ! Allocate temporary workspace 
    85       CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     86      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     87      CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    8688      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 
    8789 
     
    112114      !                                        !  -------------------------------------- 
    113115      IF( l_trcdm2dc ) THEN                     !  diurnal cycle 
    114          ! 1% of qsr to compute euphotic layer 
     116         !                                       ! 1% of qsr to compute euphotic layer 
    115117         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr 
    116118         ! 
    117          CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 )  
     119         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     120         ! 
     121         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    118122         ! 
    119123         DO jk = 1, nksrp       
     
    123127         END DO 
    124128         ! 
    125          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
     129         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     130         ! 
     131         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    126132         ! 
    127133         DO jk = 1, nksrp       
     
    133139         zqsr100(:,:) = 0.01 * qsr(:,:) 
    134140         ! 
    135          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
     141         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     142         ! 
     143         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    136144         ! 
    137145         DO jk = 1, nksrp       
     
    226234      ENDIF 
    227235      ! 
    228       CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     236      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     237      CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    229238      CALL wrk_dealloc( jpi, jpj, jpk, zpar,  ze0, ze1, ze2, ze3 ) 
    230239      ! 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r6618 r7083  
    136136                  zval = MAX( 1., zstrn(ji,jj) ) 
    137137                  zval = 1.5 * zval / ( 12. + zval ) 
    138                   zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     138                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 
    139139                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
    140140               ENDIF 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r6486 r7083  
    2626   USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    2727   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
     28   USE trd_oce 
     29   USE trdtra 
    2830   USE prtctl_trc      ! Print control 
    2931 
     
    7476      CHARACTER (len=22) ::   charout 
    7577      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
     78      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    7679      !!---------------------------------------------------------------------- 
    7780      ! 
     
    111114      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary) 
    112115      ! 
     116      IF( l_trdtrc )  THEN 
     117         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     118         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     119      ENDIF 
     120      ! 
    113121      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    114122      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
     
    140148         ! 
    141149      END SELECT 
     150      ! 
     151      IF( l_trdtrc )   THEN                      ! save the advective trends for further diagnostics 
     152        DO jn = 1, jptra 
     153           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     154           CALL trd_tra( kt, 'TRC', jn, jptra_totad, ztrtrd(:,:,:,jn) ) 
     155        END DO 
     156        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     157      ENDIF 
    142158 
    143159      !                                              ! print mean trends (used for debugging) 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r6498 r7083  
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
    3636 
    37    INTEGER, PARAMETER           ::   npncts   = 5        ! number of closed sea 
     37   INTEGER, PARAMETER           ::   npncts   = 8        ! number of closed sea 
    3838   INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j) 
    3939   INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j) 
     
    107107                
    108108               jl = n_trc_index(jn)  
    109                CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000 
    110                ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 
     109               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    111110 
    112111               SELECT CASE ( nn_zdmp_tr ) 
     
    187186      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    188187      INTEGER :: isrow                                      ! local index 
     188      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    189189 
    190190      !!---------------------------------------------------------------------- 
     
    207207            ! 
    208208                                                        ! Caspian Sea 
    209             nctsi1(1)   = 332  ; nctsj1(1)   = 243 - isrow 
    210             nctsi2(1)   = 344  ; nctsj2(1)   = 275 - isrow 
     209            nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow 
     210            nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
     211            !                                           ! Lake Superior 
     212            nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow 
     213            nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
     214            !                                           ! Lake Michigan 
     215            nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow 
     216            nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
     217            !                                           ! Lake Huron 
     218            nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow 
     219            nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
     220            !                                           ! Lake Erie 
     221            nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow 
     222            nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
     223            !                                           ! Lake Ontario 
     224            nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow 
     225            nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
     226            !                                           ! Victoria Lake 
     227            nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow 
     228            nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
     229            !                                           ! Baltic Sea 
     230            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow 
     231            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
    211232            !                                         
    212233            !                                           ! ======================= 
     
    277298         IF(lwp)  WRITE(numout,*) 
    278299         ! 
     300         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation 
     301         ! 
    279302         DO jn = 1, jptra 
    280303            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    281304                jl = n_trc_index(jn) 
    282                 CALL trc_dta( kt, sf_trcdta(jl) )   ! read tracer data at nit000 
     305                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    283306                DO jc = 1, npncts 
    284307                   DO jk = 1, jpkm1 
    285308                      DO jj = nctsj1(jc), nctsj2(jc) 
    286309                         DO ji = nctsi1(jc), nctsi2(jc) 
    287                             trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl) 
     310                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 
    288311                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    289312                         ENDDO 
     
    293316             ENDIF 
    294317          ENDDO 
    295           ! 
     318          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    296319      ENDIF 
    297320      ! 
     
    313336      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    314337      ! 
     338      !Allocate arrays 
     339      IF( trc_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_dmp_init: unable to allocate arrays' ) 
    315340 
    316341      IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r6498 r7083  
    7777      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7878      IF( ierr0 > 0 ) THEN 
    79          CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     79         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
    8080      ENDIF 
    8181      nb_trcdta      = 0 
     
    9191      IF(lwp) THEN 
    9292         WRITE(numout,*) ' ' 
     93         WRITE(numout,*) 'trc_dta_init : Passive tracers Initial Conditions ' 
     94         WRITE(numout,*) '~~~~~~~~~~~~~~ ' 
    9395         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 
    9496         WRITE(numout,*) ' ' 
     
    107109         DO jn = 1, ntrc 
    108110            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true 
    109                clndta = TRIM( sn_trcdta(jn)%clvar )  
    110                clntrc = TRIM( ctrcnm   (jn)       )  
     111               clndta = TRIM( sn_trcdta(jn)%clvar ) 
     112               if (jn > jptra) then 
     113                  clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 
     114               else 
     115                  clntrc = TRIM( ctrcnm   (jn)       ) 
     116               endif 
    111117               zfact  = rn_trfac(jn) 
    112                IF( clndta /=  clntrc ) THEN  
    113                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
    114                   &              'the variable name in the data file : '//clndta//   &  
    115                   &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     118               IF( clndta /=  clntrc ) THEN 
     119                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     120                  &              'Input name of data file : '//TRIM(clndta)//   & 
     121                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    116122               ENDIF 
    117                WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
    118                &               ' multiplicative factor : ', zfact 
     123               WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 
     124               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    119125            ENDIF 
    120126         END DO 
     
    124130         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    125131         IF( ierr1 > 0 ) THEN 
    126             CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     132            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    127133         ENDIF 
    128134         ! 
     
    135141               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    136142               IF( ierr2 + ierr3 > 0 ) THEN 
    137                  CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     143                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
    138144               ENDIF 
    139145            ENDIF 
     
    141147         ENDDO 
    142148         !                         ! fill sf_trcdta with slf_i and control print 
    143          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     149         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
    144150         ! 
    145151      ENDIF 
     
    151157 
    152158 
    153    SUBROUTINE trc_dta( kt, sf_dta ) 
     159   SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) 
    154160      !!---------------------------------------------------------------------- 
    155161      !!                   ***  ROUTINE trc_dta  *** 
     
    164170      !!---------------------------------------------------------------------- 
    165171      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
    166       TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read 
     172      TYPE(FLD), DIMENSION(1)     , INTENT(inout) ::   sf_dta     ! array of information on the field to read 
     173      REAL(wp)                    , INTENT(in   ) ::   ptrfac  ! multiplication factor 
     174      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL  , INTENT(out  ) ::   ptrc 
    167175      ! 
    168176      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
    169177      REAL(wp)::   zl, zi 
    170178      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
     179      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
    171180      CHARACTER(len=100) :: clndta 
    172181      !!---------------------------------------------------------------------- 
     
    176185      IF( nb_trcdta > 0 ) THEN 
    177186         ! 
     187         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
     188         ! 
    178189         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==! 
     190         ztrcdta(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    179191         ! 
    180192         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     
    185197            ENDIF 
    186198            ! 
    187                DO jj = 1, jpj                         ! vertical interpolation of T & S 
     199            DO jj = 1, jpj                         ! vertical interpolation of T & S 
     200               DO ji = 1, jpi 
     201                  DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     202                     zl = fsdept_n(ji,jj,jk) 
     203                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     204                        ztp(jk) = ztrcdta(ji,jj,1) 
     205                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     206                        ztp(jk) =  ztrcdta(ji,jj,jpkm1) 
     207                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     208                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     209                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     210                              zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     211                              ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 
     212                                        ztrcdta(ji,jj,jkk) ) * zi  
     213                           ENDIF 
     214                        END DO 
     215                     ENDIF 
     216                  END DO 
     217                  DO jk = 1, jpkm1 
     218                    ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     219                  END DO 
     220                  ztrcdta(ji,jj,jpk) = 0._wp 
     221                END DO 
     222            END DO 
     223            !  
     224         ELSE                                !==   z- or zps- coordinate   ==! 
     225            ! 
     226            IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     227               DO jj = 1, jpj 
    188228                  DO ji = 1, jpi 
    189                      DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    190                         zl = fsdept_n(ji,jj,jk) 
    191                         IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    192                            ztp(jk) =  sf_dta(1)%fnow(ji,jj,1) 
    193                         ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    194                            ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1) 
    195                         ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    196                            DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    197                               IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    198                                  zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    199                                  ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 
    200                                            sf_dta(1)%fnow(ji,jj,jkk) ) * zi  
    201                               ENDIF 
    202                            END DO 
    203                         ENDIF 
    204                      END DO 
    205                      DO jk = 1, jpkm1 
    206                         sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    207                      END DO 
    208                      sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 
     229                     ik = mbkt(ji,jj)  
     230                     IF( ik > 1 ) THEN 
     231                        zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     232                        ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 
     233                     ENDIF 
     234                     ik = mikt(ji,jj) 
     235                     IF( ik > 1 ) THEN 
     236                        zl = ( fsdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
     237                        ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 
     238                     ENDIF 
    209239                  END DO 
    210240               END DO 
    211             !  
    212          ELSE                                !==   z- or zps- coordinate   ==! 
    213             !                              
    214                sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    215                ! 
    216                IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    217                   DO jj = 1, jpj 
    218                      DO ji = 1, jpi 
    219                         ik = mbkt(ji,jj)  
    220                         IF( ik > 1 ) THEN 
    221                            zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    222                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 
    223                         ENDIF 
    224                         ik = mikt(ji,jj) 
    225                         IF( ik > 1 ) THEN 
    226                            zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    227                            sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1) 
    228                         ENDIF 
    229                      END DO 
    230                   END DO 
    231                ENDIF 
    232             ! 
    233          ENDIF 
     241            ENDIF 
     242            ! 
     243         ENDIF 
     244         ! 
     245         ! Add multiplicative factor 
     246         ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 
     247         ! 
     248         ! Data structure for trc_ini (and BFMv5.1 coupling) 
     249         IF( .NOT. PRESENT(ptrc) ) sf_dta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 
     250         ! 
     251         ! Data structure for trc_dmp 
     252         IF( PRESENT(ptrc) )  ptrc(:,:,:) = ztrcdta(:,:,:) 
    234253         ! 
    235254         IF( lwp .AND. kt == nit000 ) THEN 
     
    238257               WRITE(numout,*) 
    239258               WRITE(numout,*)'  level = 1' 
    240                CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     259               CALL prihre( ztrcdta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    241260               WRITE(numout,*)'  level = ', jpk/2 
    242                CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     261               CALL prihre( ztrcdta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    243262               WRITE(numout,*)'  level = ', jpkm1 
    244                CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     263               CALL prihre( ztrcdta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    245264               WRITE(numout,*) 
    246265         ENDIF 
     266         ! 
     267         CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
     268         ! 
    247269      ENDIF 
    248270      ! 
     
    255277   !!---------------------------------------------------------------------- 
    256278CONTAINS 
    257    SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine 
     279   SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc)        ! Empty routine 
    258280      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    259281   END SUBROUTINE trc_dta 
  • branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6731 r7083  
    125125               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    126126                  jl = n_trc_index(jn)  
    127                   CALL trc_dta( nit000, sf_trcdta(jl) )   ! read tracer data at nit000 
    128                   trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 
    129                   ! 
     127                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) )   ! read tracer data at nit000 
     128                  trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:)  
    130129                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
    131130                     !                                                    (data used only for initialisation) 
Note: See TracChangeset for help on using the changeset viewer.