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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r4624 r6225  
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
    1010   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
    11    !!---------------------------------------------------------------------- 
    12 #if  defined key_top  
     11   !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_top  
    1314   !!---------------------------------------------------------------------- 
    1415   !!   'key_top'                                                TOP model  
     
    3637   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    3738!$AGRIF_END_DO_NOT_TREAT 
    38    !! * Substitutions 
    39 #  include "domzgr_substitute.h90" 
     39 
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    7272      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
    7373      ! 
     74      IF( lwp ) THEN 
     75         WRITE(numout,*) ' ' 
     76         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     77         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
     78      ENDIF 
     79      ! 
    7480      !  Initialisation 
    7581      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     
    7783      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7884      IF( ierr0 > 0 ) THEN 
    79          CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     85         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
    8086      ENDIF 
    8187      nb_trcdta      = 0 
     
    97103      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    98104      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    99 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 
     105901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
    100106 
    101107      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    102108      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    103 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 
     109902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
    104110      IF(lwm) WRITE ( numont, namtrc_dta ) 
    105111 
     
    109115               clndta = TRIM( sn_trcdta(jn)%clvar )  
    110116               clntrc = TRIM( ctrcnm   (jn)       )  
     117               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 
    111118               zfact  = rn_trfac(jn) 
    112119               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//' ') 
     120                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     121                  &              'Input name of data file : '//TRIM(clndta)//   & 
     122                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    116123               ENDIF 
    117                WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
    118                &               ' multiplicative factor : ', zfact 
     124               WRITE(numout,*) ' ' 
     125               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 
     126               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    119127            ENDIF 
    120128         END DO 
     
    124132         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    125133         IF( ierr1 > 0 ) THEN 
    126             CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     134            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    127135         ENDIF 
    128136         ! 
     
    135143               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    136144               IF( ierr2 + ierr3 > 0 ) THEN 
    137                  CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     145                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
    138146               ENDIF 
    139147            ENDIF 
     
    141149         ENDDO 
    142150         !                         ! 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' ) 
     151         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
    144152         ! 
    145153      ENDIF 
     
    189197                  DO ji = 1, jpi 
    190198                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    191                         zl = fsdept_n(ji,jj,jk) 
     199                        zl = gdept_n(ji,jj,jk) 
    192200                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    193201                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1) 
     
    220228                        ik = mbkt(ji,jj)  
    221229                        IF( ik > 1 ) THEN 
    222                            zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     230                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    223231                           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) 
    224232                        ENDIF 
     
    231239         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor 
    232240         ! 
    233          IF( lwp .AND. kt == nit000 ) THEN 
    234                clndta = TRIM( sf_dta(1)%clvar )  
    235                WRITE(numout,*) ''//clndta//' data ' 
    236                WRITE(numout,*) 
    237                WRITE(numout,*)'  level = 1' 
    238                CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    239                WRITE(numout,*)'  level = ', jpk/2 
    240                CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    241                WRITE(numout,*)'  level = ', jpkm1 
    242                CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    243                WRITE(numout,*) 
    244          ENDIF 
    245241      ENDIF 
    246242      ! 
     
    248244      ! 
    249245   END SUBROUTINE trc_dta 
     246    
    250247#else 
    251248   !!---------------------------------------------------------------------- 
     
    257254   END SUBROUTINE trc_dta 
    258255#endif 
     256 
    259257   !!====================================================================== 
    260258END MODULE trcdta 
Note: See TracChangeset for help on using the changeset viewer.