Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (4 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r6701 r7646  
    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    !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
     11   !!            3.6   !  2015-03  (T. Lovato) revisit code I/O 
    1212   !!---------------------------------------------------------------------- 
    1313#if defined key_top  
     
    2828 
    2929   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
    30    PUBLIC   trc_dta_init    ! called in trcini.F90  
     30   PUBLIC   trc_dta_ini     ! called in trcini.F90  
    3131 
    3232   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
     
    4545CONTAINS 
    4646 
    47    SUBROUTINE trc_dta_init(ntrc) 
    48       !!---------------------------------------------------------------------- 
    49       !!                   ***  ROUTINE trc_dta_init  *** 
     47   SUBROUTINE trc_dta_ini(ntrc) 
     48      !!---------------------------------------------------------------------- 
     49      !!                   ***  ROUTINE trc_dta_ini  *** 
    5050      !!                     
    5151      !! ** Purpose :   initialisation of passive tracer input data  
     
    7070      !!---------------------------------------------------------------------- 
    7171      ! 
    72       IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
     72      IF( nn_timing == 1 )  CALL timing_start('trc_dta_ini') 
    7373      ! 
    7474      IF( lwp ) THEN 
    7575         WRITE(numout,*) ' ' 
    76          WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     76         WRITE(numout,*) '  trc_dta_ini : Tracers Initial Conditions (IC)' 
    7777         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
    7878      ENDIF 
     
    8383      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    8484      IF( ierr0 > 0 ) THEN 
    85          CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
     85         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN 
    8686      ENDIF 
    8787      nb_trcdta      = 0 
     
    103103      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    104104      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    105 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
     105901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    106106 
    107107      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    108108      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    109 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
     109902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
    110110      IF(lwm) WRITE ( numont, namtrc_dta ) 
    111111 
     
    118118               zfact  = rn_trfac(jn) 
    119119               IF( clndta /=  clntrc ) THEN  
    120                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     120                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   & 
    121121                  &              'Input name of data file : '//TRIM(clndta)//   & 
    122122                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
     
    132132         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    133133         IF( ierr1 > 0 ) THEN 
    134             CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     134            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    135135         ENDIF 
    136136         ! 
     
    143143               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    144144               IF( ierr2 + ierr3 > 0 ) THEN 
    145                  CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
     145                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN 
    146146               ENDIF 
    147147            ENDIF 
     
    149149         ENDDO 
    150150         !                         ! fill sf_trcdta with slf_i and control print 
    151          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
     151         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' ) 
    152152         ! 
    153153      ENDIF 
    154154      ! 
    155155      DEALLOCATE( slf_i )          ! deallocate local field structure 
    156       IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init') 
    157       ! 
    158    END SUBROUTINE trc_dta_init 
    159  
    160  
    161    SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) 
     156      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_ini') 
     157      ! 
     158   END SUBROUTINE trc_dta_ini 
     159 
     160 
     161   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) 
    162162      !!---------------------------------------------------------------------- 
    163163      !!                   ***  ROUTINE trc_dta  *** 
     
    169169      !!              - ln_trcdmp=F: deallocates the data structure as they are not used 
    170170      !! 
    171       !! ** Action  :   sf_trcdta   passive tracer data on medl mesh and interpolated at time-step kt 
    172       !!---------------------------------------------------------------------- 
    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 
     171      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt 
     172      !!---------------------------------------------------------------------- 
     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   )   ::   ptrcfac    ! multiplication factor 
     176      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array 
    177177      ! 
    178178      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
    179179      REAL(wp)::   zl, zi 
    180180      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
    181       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
    182181      CHARACTER(len=100) :: clndta 
    183182      !!---------------------------------------------------------------------- 
     
    187186      IF( nb_trcdta > 0 ) THEN 
    188187         ! 
    189          CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    190          ! 
    191          CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
    192          ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    193          ! 
    194          IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     188         ! read data at kt time step 
     189         CALL fld_read( kt, 1, sf_trcdta ) 
     190         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 
     191         !  
     192         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==! 
    195193            ! 
    196194            IF( kt == nit000 .AND. lwp )THEN 
     
    203201                     zl = gdept_n(ji,jj,jk) 
    204202                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    205                         ztp(jk) = ztrcdta(ji,jj,1) 
     203                        ztp(jk) = ptrcdta(ji,jj,1) 
    206204                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    207                         ztp(jk) =  ztrcdta(ji,jj,jpkm1) 
     205                        ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    208206                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    209207                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    210208                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    211209                              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  
     210                              ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
    214211                           ENDIF 
    215212                        END DO 
     
    217214                  END DO 
    218215                  DO jk = 1, jpkm1 
    219                     ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     216                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    220217                  END DO 
    221                   ztrcdta(ji,jj,jpk) = 0._wp 
     218                  ptrcdta(ji,jj,jpk) = 0._wp 
    222219                END DO 
    223220            END DO 
    224221            !  
    225222         ELSE                                !==   z- or zps- coordinate   ==! 
    226             ! 
    227             IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     223            ! zps-coordinate (partial steps) interpolation at the last ocean level 
     224            IF( ln_zps ) THEN 
    228225               DO jj = 1, jpj 
    229226                  DO ji = 1, jpi 
     
    231228                     IF( ik > 1 ) THEN 
    232229                        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) 
     230                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 
    234231                     ENDIF 
    235232                     ik = mikt(ji,jj) 
    236233                     IF( ik > 1 ) THEN 
    237234                        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) 
     235                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 
    239236                     ENDIF 
    240237                  END DO 
     
    244241         ENDIF 
    245242         ! 
    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 ) 
     243         ! Scale by multiplicative factor 
     244         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac 
    256245         ! 
    257246      ENDIF 
     
    266255   !!---------------------------------------------------------------------- 
    267256CONTAINS 
    268    SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)        ! Empty routine 
     257   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine 
    269258      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    270259   END SUBROUTINE trc_dta 
Note: See TracChangeset for help on using the changeset viewer.