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 6701 – NEMO

Changeset 6701


Ignore:
Timestamp:
2016-06-13T17:29:32+02:00 (8 years ago)
Author:
lovato
Message:

#1677 - trunk: Update code for passive tracers data input and restoring

Location:
trunk/NEMOGCM/NEMO
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r6472 r6701  
    111111         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    112112            zfact = 1._wp 
     113            sbc_tsc(:,:,:) = 0._wp 
    113114            sbc_tsc_b(:,:,:) = 0._wp 
    114115         ENDIF 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r6607 r6701  
    100100            !                                                       ! =========== 
    101101            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
    102             CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000 
    103102            ! 
    104103            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    105104               ! 
    106105               jl = n_trc_index(jn)  
     106               CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    107107               ! 
    108108               SELECT CASE ( nn_zdmp_tr ) 
     
    112112                     DO jj = 2, jpjm1 
    113113                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    114                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl)  - trb(ji,jj,jk,jn) ) 
     114                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    115115                        END DO 
    116116                     END DO 
     
    122122                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    123123                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
    124                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 
     124                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    125125                           ENDIF 
    126126                        END DO 
     
    133133                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    134134                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    135                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 
     135                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    136136                           END IF 
    137137                        END DO 
     
    180180      !!---------------------------------------------------------------------- 
    181181      ! 
    182       IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
     182      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_ini') 
    183183      ! 
    184184      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
     
    199199         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
    200200      ENDIF 
     201      !                          ! Allocate arrays 
     202      IF( trc_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' ) 
    201203      ! 
    202204      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
     
    240242      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    241243      ! 
    242       INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     244      INTEGER :: ji , jj, jk, jn, jl, jc                    ! dummy loop indicesa 
    243245      INTEGER :: isrow                                      ! local index 
    244       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 3D  workspace 
     246      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    245247 
    246248      !!---------------------------------------------------------------------- 
     
    286288            nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow 
    287289            nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
    288                                  
     290            !                                         
    289291            !                                           ! ======================= 
    290292            CASE ( 2 )                                  !  ORCA_R2 configuration 
     
    354356         IF(lwp)  WRITE(numout,*) 
    355357         ! 
    356          CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
    357          CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000 
     358         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation 
    358359         ! 
    359360         DO jn = 1, jptra 
    360361            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    361362                jl = n_trc_index(jn) 
    362                 IF(lwp)  WRITE(numout,*) 
     363                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    363364                DO jc = 1, npncts 
    364365                   DO jk = 1, jpkm1 
    365366                      DO jj = nctsj1(jc), nctsj2(jc) 
    366367                         DO ji = nctsi1(jc), nctsi2(jc) 
    367                             trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) 
     368                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 
    368369                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    369370                         ENDDO 
     
    373374             ENDIF 
    374375          ENDDO 
    375           CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
    376           ! 
     376          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    377377      ENDIF 
    378378      ! 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r6619 r6701  
    123123               ENDIF 
    124124               WRITE(numout,*) ' ' 
    125                WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 
     125               WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 
    126126               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    127127            ENDIF 
     
    159159 
    160160 
    161    SUBROUTINE trc_dta( kt, ptrc ) 
     161   SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) 
    162162      !!---------------------------------------------------------------------- 
    163163      !!                   ***  ROUTINE trc_dta  *** 
     
    171171      !! ** Action  :   sf_trcdta   passive tracer data on medl mesh and interpolated at time-step kt 
    172172      !!---------------------------------------------------------------------- 
    173       INTEGER                       , INTENT(in   ) ::   kt     ! ocean time-step 
    174       REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) ::   ptrc     ! array of information on the field to read 
     173      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
     174      TYPE(FLD), DIMENSION(1)     , INTENT(inout) ::   sf_trcdta     ! array of information on the field to read 
     175      REAL(wp)                    , INTENT(in   ) ::   ptrfac  ! multiplication factor 
     176      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL  , INTENT(out  ) ::   ptrc 
    175177      ! 
    176178      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
    177179      REAL(wp)::   zl, zi 
    178180      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
     181      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
     182      CHARACTER(len=100) :: clndta 
    179183      !!---------------------------------------------------------------------- 
    180184      ! 
     
    183187      IF( nb_trcdta > 0 ) THEN 
    184188         ! 
     189         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
     190         ! 
    185191         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
    186          ! 
    187          DO jl = 1, nb_trcdta 
    188             ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    189          ENDDO 
     192         ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    190193         ! 
    191194         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     
    195198               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    196199            ENDIF 
    197             DO jl = 1, nb_trcdta 
    198                DO jj = 1, jpj                         ! vertical interpolation of T & S 
    199                   DO ji = 1, jpi 
    200                      DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    201                         zl = gdept_n(ji,jj,jk) 
    202                         IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    203                            ztp(jk) =  ptrc(ji,jj,1,jl) 
    204                         ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    205                            ztp(jk) =  ptrc(ji,jj,jpkm1,jl) 
    206                         ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    207                            DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    208                               IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    209                                  zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    210                                  ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi  
    211                               ENDIF 
    212                            END DO 
    213                         ENDIF 
    214                      END DO 
    215                      DO jk = 1, jpkm1 
    216                         ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    217                      END DO 
    218                      ptrc(ji,jj,jpk,jl) = 0._wp 
     200            DO jj = 1, jpj                         ! vertical interpolation of T & S 
     201               DO ji = 1, jpi 
     202                  DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     203                     zl = gdept_n(ji,jj,jk) 
     204                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
     205                        ztp(jk) = ztrcdta(ji,jj,1) 
     206                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
     207                        ztp(jk) =  ztrcdta(ji,jj,jpkm1) 
     208                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     209                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(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) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 
     213                                        ztrcdta(ji,jj,jkk) ) * zi  
     214                           ENDIF 
     215                        END DO 
     216                     ENDIF 
    219217                  END DO 
    220                END DO 
     218                  DO jk = 1, jpkm1 
     219                    ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     220                  END DO 
     221                  ztrcdta(ji,jj,jpk) = 0._wp 
     222                END DO 
    221223            END DO 
    222224            !  
    223225         ELSE                                !==   z- or zps- coordinate   ==! 
    224             !                              
     226            ! 
    225227            IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    226                DO jl = 1, nb_trcdta 
    227                   ! 
    228                   DO jj = 1, jpj 
    229                      DO ji = 1, jpi 
    230                         ik = mbkt(ji,jj)  
    231                         IF( ik > 1 ) THEN 
    232                            zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    233                            ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl) 
    234                         ENDIF 
    235                      END DO 
     228               DO jj = 1, jpj 
     229                  DO ji = 1, jpi 
     230                     ik = mbkt(ji,jj)  
     231                     IF( ik > 1 ) THEN 
     232                        zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     233                        ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 
     234                     ENDIF 
     235                     ik = mikt(ji,jj) 
     236                     IF( ik > 1 ) THEN 
     237                        zl = ( gdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
     238                        ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 
     239                     ENDIF 
    236240                  END DO 
    237241              END DO 
     
    240244         ENDIF 
    241245         ! 
    242       ENDIF 
    243       !  
    244       IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
    245         !                                                    (data used only for initialisation) 
    246         IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 
    247         DO jl = 1, nb_trcdta 
    248                                         DEALLOCATE( sf_trcdta(jl)%fnow)     !  arrays in the structure 
    249            IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta) 
    250         ENDDO 
     246         ! Add multiplicative factor 
     247         ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 
     248         ! 
     249         ! Data structure for trc_ini (and BFMv5.1 coupling) 
     250         IF( .NOT. PRESENT(ptrc) ) sf_trcdta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 
     251         ! 
     252         ! Data structure for trc_dmp 
     253         IF( PRESENT(ptrc) )  ptrc(:,:,:) = ztrcdta(:,:,:) 
     254         ! 
     255         CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
     256         ! 
    251257      ENDIF 
    252258      ! 
     
    260266   !!---------------------------------------------------------------------- 
    261267CONTAINS 
    262    SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine 
     268   SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)        ! Empty routine 
    263269      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    264270   END SUBROUTINE trc_dta 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6607 r6701  
    203203      USE trcdta          ! initialisation from files 
    204204      ! 
    205       INTEGER ::   jk, jn, jl    ! dummy loop indices 
    206       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta 
     205      INTEGER :: jn, jl   ! dummy loop indices 
    207206      !!---------------------------------------------------------------------- 
    208207      ! 
     
    220219        ! 
    221220        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    222             ! 
    223             CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
    224             ! 
    225             CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
    226221            ! 
    227222            DO jn = 1, jptra 
    228223               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    229224                  jl = n_trc_index(jn)  
    230                   trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * rf_trfac(jl) 
     225                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) )   ! read tracer data at nit000 
     226                  trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:)  
     227                  ! 
     228                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
     229                     !                                                    (data used only for initialisation) 
     230                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 
     231                                                  DEALLOCATE( sf_trcdta(jl)%fnow )     !  arrays in the structure 
     232                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta ) 
     233                     ! 
     234                  ENDIF 
    231235               ENDIF 
    232236            ENDDO 
    233237            ! 
    234             CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
    235             !  
    236238        ENDIF 
    237239        ! 
Note: See TracChangeset for help on using the changeset viewer.