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.
trcdta.F90 in branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 2633

Last change on this file since 2633 was 2593, checked in by trackstand2, 13 years ago

Made module vars dynamic and added _alloc() routine
  • Property svn:keywords set to Id
File size: 9.7 KB
RevLine 
[268]1MODULE trcdta
2   !!======================================================================
[433]3   !!                     ***  MODULE  trcdta  ***
[945]4   !! TOP :  reads passive tracer data
[268]5   !!=====================================================================
[945]6   !! History :   1.0  !  2002-04  (O. Aumont)  original code
7   !!              -   !  2004-03  (C. Ethe)  module
8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
[274]9   !!----------------------------------------------------------------------
[945]10#if  defined key_top  &&  defined key_dtatrc
[268]11   !!----------------------------------------------------------------------
[945]12   !!   'key_top'  and  'key_dtatrc'        TOP model + passive tracer data
[268]13   !!----------------------------------------------------------------------
[1077]14   !!   trc_dta      : read ocean passive tracer data
[268]15   !!----------------------------------------------------------------------
[335]16   USE oce_trc
[945]17   USE par_trc
[335]18   USE trc
19   USE lib_print
[945]20   USE iom
[268]21
22   IMPLICIT NONE
23   PRIVATE
24
[2593]25   PUBLIC trc_dta         ! called in trcini.F90 and trcdmp.F90
26   PUBLIC trc_dta_alloc   ! called in nemogcm.F90
[268]27
[1801]28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag
[2593]29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trdta   !: tracer data at given time-step
[268]30
[2593]31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times
32   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once
33   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of first month when reading 12 monthly value
34   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of second month when reading 12 monthly value
[268]35
36   !! * Substitutions
[945]37#  include "top_substitute.h90"
[268]38   !!----------------------------------------------------------------------
[2528]39   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1152]40   !! $Id$
[2528]41   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[268]42   !!----------------------------------------------------------------------
43CONTAINS
44
[2593]45   FUNCTION trc_dta_alloc()
46      !!----------------------------------------------------------------------
47      !!                   ***  ROUTINE trc_dta_alloc  ***
48      !!----------------------------------------------------------------------
49      INTEGER :: trc_dta_alloc
50      !!----------------------------------------------------------------------
51
52      ALLOCATE(trdta(jpi,jpj,jpk,jptra),                   &
53               tracdta(jpi,jpj,jpk,jptra,2),               &
54               nlectr(jptra), ntrc1(jptra), ntrc2,(jptra), & 
55               !
56               Stat = trc_dta_alloc)
57
58      IF(trc_dta_alloc /= 0)THEN
59         CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.')
60      END IF
61
62   END FUNCTION trc_dta_alloc
63
64
[1011]65   SUBROUTINE trc_dta( kt )
[335]66      !!----------------------------------------------------------------------
[1011]67      !!                   ***  ROUTINE trc_dta  ***
[335]68      !!
69      !! ** Purpose :   Reads passive tracer data (Levitus monthly data)
70      !!
71      !! ** Method  :   Read on unit numtr the interpolated tracer concentra-
72      !!      tion onto the global grid. Data begin at january.
73      !!      The value is centered at the middle of month.
74      !!      In the opa model, kt=1 agree with january 1.
75      !!      At each time step, a linear interpolation is applied between
76      !!      two monthly values.
77      !!----------------------------------------------------------------------
[268]78      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
[945]79      !!
80      CHARACTER (len=39) ::   clname(jptra)
[2528]81      INTEGER, PARAMETER ::   jpmonth = 12    ! number of months
[945]82      INTEGER ::   ji, jj, jn, jl 
83      INTEGER ::   imois, iman, i15, ik  ! temporary integers
84      REAL(wp) ::   zxy, zl
[2528]85!!gm HERE the daymod should be used instead of computation of month and co !!
86!!gm      better in case of real calandar and leap-years !
[335]87      !!----------------------------------------------------------------------
[268]88
89      DO jn = 1, jptra
90
[335]91         IF( lutini(jn) ) THEN
[268]92
[2528]93            IF ( kt == nit000 ) THEN
[335]94               !! 3D tracer data
95               IF(lwp)WRITE(numout,*)
[433]96               IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer' 
97               IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn)
[335]98               IF(lwp)WRITE(numout,*)
99               nlectr(jn) = 0
100            ENDIF
101            ! Initialization
[1801]102            iman = jpmonth
[1077]103            i15  = nday / 16
[335]104            imois = nmonth + i15 -1
105            IF( imois == 0 ) imois = iman
[268]106
[493]107
[335]108            ! First call kt=nit000
109            ! --------------------
[268]110
[2528]111            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN
[335]112               ntrc1(jn) = 0
[493]113               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields'
[335]114               ! open file
[945]115# if defined key_pisces
[1645]116               clname(jn) = 'data_1m_'//TRIM(ctrcnm(jn))//'_nomask'
[945]117# else
[1645]118               clname(jn) = TRIM(ctrcnm(jn))
[945]119# endif
[493]120               CALL iom_open ( clname(jn), numtr(jn) )             
[268]121
122            ENDIF
123
[945]124# if defined key_pisces
[335]125            ! Read montly file
[2528]126            IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN
[335]127               nlectr(jn) = 1
[268]128
[335]129               ! Calendar computation
[268]130
[335]131               ! ntrc1 number of the first file record used in the simulation
132               ! ntrc2 number of the last  file record
[268]133
[335]134               ntrc1(jn) = imois
135               ntrc2(jn) = ntrc1(jn) + 1
136               ntrc1(jn) = MOD( ntrc1(jn), iman )
137               IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman
138               ntrc2(jn) = MOD( ntrc2(jn), iman )
139               IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman
140               IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 
141               IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', ntrc2(jn)
[268]142
[335]143               ! Read montly passive tracer data Levitus
[268]144
[493]145               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,1), ntrc1(jn) )
146               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,2), ntrc2(jn) )
[268]147
[335]148               IF(lwp) THEN
149                  WRITE(numout,*)
150                  WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok'
151                  WRITE(numout,*)
152               ENDIF
[268]153
[335]154               ! Apply Mask
155               DO jl = 1, 2
156                  tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 
157                  tracdta(:,:,jpk,jn,jl) = 0.
[493]158                  IF( ln_zps ) THEN                ! z-coord. with partial steps
[335]159                     DO jj = 1, jpj                ! interpolation of temperature at the last level
160                        DO ji = 1, jpi
[2528]161                           ik = mbkt(ji,jj)
[335]162                           IF( ik > 2 ) THEN
[1645]163                              zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
164                              tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik  ,jn,jl)    &
[945]165                                 &                    +     zl  * tracdta(ji,jj,ik-1,jn,jl)
[335]166                           ENDIF
167                        END DO
168                     END DO
169                  ENDIF
[268]170
171               END DO
[335]172
[268]173            ENDIF
174
[335]175            IF(lwp) THEN
[945]176               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn)
[335]177               WRITE(numout,*)
[945]178               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = 1'
[335]179               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   &
[945]180                  &        ,jpj, 20, 1., numout )
181               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = ',jpk/2
[335]182               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    &
[945]183                  &         20, 1, jpj, 20, 1., numout )
184               WRITE(numout,*) ' Levitus month = ',ntrc1(jn),'  level = ',jpkm1
[335]185               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     &
[945]186                  &         20, 1, jpj, 20, 1., numout )
[335]187            ENDIF
[268]188
[335]189            ! At every time step compute temperature data
190            zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
[945]191            trdta(:,:,:,jn) =  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    &
192               &              +       zxy   * tracdta(:,:,:,jn,2) 
[268]193
[945]194            IF( jn == jpno3 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   7.6e-6
195            IF( jn == jpdic )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
196            IF( jn == jptal )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
197            IF( jn == jpoxy )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *  44.6e-6
198            IF( jn == jpsil )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
199            IF( jn == jppo4 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6
[493]200
201            ! Close the file
202            ! --------------
203           
[945]204            IF( kt == nitend )   CALL iom_close( numtr(jn) )
[493]205
[945]206# else
[433]207            ! Read init file only
[2528]208            IF( kt == nit000  ) THEN
[1796]209               ntrc1(jn) = 1
[493]210               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) )
211               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)
212               CALL iom_close ( numtr(jn) )
[433]213            ENDIF 
[945]214# endif
215         ENDIF
[268]216
[945]217      END DO
218      !
[1011]219   END SUBROUTINE trc_dta
[268]220
221#else
222   !!----------------------------------------------------------------------
[945]223   !!   Dummy module                              NO 3D passive tracer data
[268]224   !!----------------------------------------------------------------------
[1801]225   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag
[268]226CONTAINS
[1011]227   SUBROUTINE trc_dta( kt )        ! Empty routine
228      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
229   END SUBROUTINE trc_dta
[268]230#endif
231
[945]232   !!======================================================================
[268]233END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.