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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcdta.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcdta.F90

    r10222 r13463  
    3939!$AGRIF_END_DO_NOT_TREAT 
    4040 
     41   !! Substitutions 
     42#include "do_loop_substitute.h90" 
     43#include "domzgr_substitute.h90" 
    4144   !!---------------------------------------------------------------------- 
    4245   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    98101      ENDIF 
    99102      ! 
    100       REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    101103      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    102 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    103       REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
     104901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' ) 
    104105      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    105 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
     106902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' ) 
    106107      IF(lwm) WRITE ( numont, namtrc_dta ) 
    107108 
    … …  
    154155 
    155156 
    156    SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) 
     157   SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta) 
    157158      !!---------------------------------------------------------------------- 
    158159      !!                   ***  ROUTINE trc_dta  *** 
    … …  
    167168      !!---------------------------------------------------------------------- 
    168169      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
     170      INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index 
    169171      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read 
    170172      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor 
    … …  
    178180      ! 
    179181      IF( ln_timing )   CALL timing_start('trc_dta') 
     182      ! 
     183      IF( kt == nit000 .AND. lwp) THEN 
     184         WRITE(numout,*) 
     185         WRITE(numout,*) 'trc_dta : passive tracers data for IC' 
     186         WRITE(numout,*) '~~~~~~~ ' 
     187      ENDIF 
    180188      ! 
    181189      IF( nb_trcdta > 0 ) THEN 
    … …  
    191199               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    192200            ENDIF 
    193             DO jj = 1, jpj                         ! vertical interpolation of T & S 
    194                DO ji = 1, jpi 
    195                   DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    196                      zl = gdept_n(ji,jj,jk) 
    197                      IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    198                         ztp(jk) = ptrcdta(ji,jj,1) 
    199                      ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    200                         ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    201                      ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    202                         DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    203                            IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    204                               zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    205                               ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
    206                            ENDIF 
    207                         END DO 
    208                      ENDIF 
    209                   END DO 
    210                   DO jk = 1, jpkm1 
    211                      ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    212                   END DO 
    213                   ptrcdta(ji,jj,jpk) = 0._wp 
    214                 END DO 
    215             END DO 
     201            DO_2D( 1, 1, 1, 1 ) 
     202               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     203                  zl = gdept(ji,jj,jk,Kmm) 
     204                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     205                     ztp(jk) = ptrcdta(ji,jj,1) 
     206                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     207                     ztp(jk) = ptrcdta(ji,jj,jpkm1) 
     208                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     209                     DO jkk = 1, jpkm1                                  ! when  gdept_1d(jkk) < zl < gdept_1d(jkk+1) 
     210                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     211                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     212                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
     213                        ENDIF 
     214                     END DO 
     215                  ENDIF 
     216               END DO 
     217               DO jk = 1, jpkm1 
     218                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     219               END DO 
     220               ptrcdta(ji,jj,jpk) = 0._wp 
     221            END_2D 
    216222            !  
    217223         ELSE                                !==   z- or zps- coordinate   ==! 
Note: See TracChangeset for help on using the changeset viewer.