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.
fldread.F90 in trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/fldread.F90 @ 702

Last change on this file since 702 was 702, checked in by smasson, 17 years ago

add first set of new surface module, see ticket:3
  • Property svn:executable set to *
File size: 14.2 KB
Line 
1MODULE fldread
2   !!======================================================================
3   !!                       ***  MODULE  fldread  ***
4   !! Ocean forcing:  read input field for surface boundary condition
5   !!=====================================================================
6   !! History :  9.0  !  06-06  (G. Madec) Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   fld_read      : read input fields used for the computation of the
11   !!                   surface boundary condition
12   !!----------------------------------------------------------------------
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! ???
16   USE daymod          ! calendar
17   USE in_out_manager  ! I/O manager
18   USE iom             ! I/O manager library
19
20   IMPLICIT NONE
21   PRIVATE   
22
23   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
24      CHARACTER(len = 34) ::   clname      ! generic name of the NetCDF flux file
25      REAL(wp)            ::   freqh       ! frequency of each flux file
26      CHARACTER(len = 34) ::   clvar       ! generic name of the variable in the NetCDF flux file
27      LOGICAL             ::   ln_tint     ! time interpolation or not (T/F)
28      INTEGER             ::   nclim       ! =0 interannuel, =1 climatology
29      INTEGER             ::   nstrec      ! starting record, used if nclim=1 (=0 last record of previous year)
30   END TYPE FLD_N
31
32   TYPE, PUBLIC ::   FLD        !: Input field related variables
33      CHARACTER(len = 256)            ::   clrootname   ! generic name of the NetCDF file
34      CHARACTER(len = 256)            ::   clname       ! current name of the NetCDF file
35      REAL(wp)                        ::   freqh        ! frequency of each flux file
36      CHARACTER(len = 34)             ::   clvar        ! generic name of the variable in the NetCDF flux file
37      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
38      INTEGER                         ::   nyear        ! year of the file (=0000 if climatology)
39      INTEGER                         ::   nclim        ! =0 interannuel, =1 climatology
40      INTEGER                         ::   nstrec       ! starting record if nclim=1 (=0 last record of previous year)
41      INTEGER                         ::   num          ! logical units of the jpfld files to be read
42      REAL(wp) , DIMENSION(2)         ::   rec_b        ! before record info (1: index, 2: second since Jan. 1st 00h)
43      REAL(wp) , DIMENSION(2)         ::   rec_n        ! now    record info (1: index, 2: second since Jan. 1st 00h)
44      REAL(wp) , DIMENSION(2)         ::   rec_a        ! next   record info (1: index, 2: second since Jan. 1st 00h)
45      REAL(wp) , DIMENSION(2)         ::   rec          ! record time in second since jan. 1st for the 2 records read
46      REAL(wp) , DIMENSION(jpi,jpj)   ::   fnow         ! input fields interpolated to now time step
47      REAL(wp) , DIMENSION(jpi,jpj,2) ::   fdta         !  2 consecutive record of input fields
48   END TYPE FLD
49
50   PUBLIC   fld_read    ! called by sbc... modules
51
52   !!----------------------------------------------------------------------
53   !!   OPA 9.0 , LOCEAN-IPSL (2006)
54   !! $Header: $
55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57
58CONTAINS
59
60   SUBROUTINE fld_read( kt, kn_fsbc, sd )
61      !!---------------------------------------------------------------------
62      !!                    ***  ROUTINE fld_read  ***
63      !!                   
64      !! ** Purpose :   provide at each time step the surface ocean fluxes
65      !!                (momentum, heat, freshwater and runoff)
66      !!
67      !! ** Method  :   READ each input fields in NetCDF files using IOM
68      !!      and intepolate it to the model time-step.
69      !!         Several assumptions are made on the input file:
70      !!      blahblahblah....
71      !!----------------------------------------------------------------------
72      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
73      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! ocean time step
74      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
75      !!
76      INTEGER  ::   jf                     ! dummy indices
77      INTEGER  ::   imf                    ! size of the structure sd
78      REAL(wp) ::   zt                     ! ratio at kt between the 2 records
79      REAL(wp), DIMENSION(2) ::   zrec_kt
80      !!---------------------------------------------------------------------
81
82      imf = SIZE( sd )       ! dummy indices
83
84      !                                         ! ===================== !
85      DO jf = 1, imf                            !    LOOP OVER FIELD    !
86         !                                      ! ===================== !
87         !
88         !                                            ! ====================== !
89         IF( kt == nit000 ) THEN                      !     Initialisation     !
90            !                                         ! ====================== !
91            !
92            !                                             ! set filename for current year
93            SELECT CASE( sd(jf)%nclim )
94            CASE( 0 )   
95               WRITE(sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear
96               sd(jf)%nyear = nyear
97            CASE( 1 )   
98               WRITE(sd(jf)%clname, '(a,  "_0000.nc")' ) TRIM( sd(jf)%clrootname )
99               sd(jf)%nyear = 0000
100            END SELECT
101            CALL iom_open( sd(jf)%clname, sd(jf)%num )    ! open input files
102            !
103            IF( sd(jf)%ln_tint ) THEN                     ! time interpolation: read previous record in now field
104               !
105               sd(jf)%rec_n = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 )     ! record index and time
106               !
107               !                                                                            ! read record
108               CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) )
109               !
110               !                                                                            ! control print
111               IF(lwp) WRITE(numout,*)' fld_read : time-interpolation for ', TRIM( sd(jf)%clvar ),   &
112                  &   ' read previous record =', INT(sd(jf)%rec_n(1)), ' at time = ', sd(jf)%rec_n(2)/rday, ' days'
113               !
114            ENDIF
115            !                                              ! next record to be read
116            sd(jf)%rec_a = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 )
117
118            IF(lwp) WRITE(numout,*)'                                   ',    &
119                  &   ' after record         =', INT(sd(jf)%rec_a(1)), ' at time = ', sd(jf)%rec_a(2)/rday, ' days'
120            !
121         ENDIF
122         !
123         !                                            ! ============================= !
124         IF( sd(jf)%nclim == 0   .AND.   &            !            New Year           !
125             sd(jf)%nyear == nyear - 1 ) THEN         ! ============================= !
126            !
127            CALL iom_close( sd(jf)%num )
128            IF(lwp) WRITE(numout,*) 'fldread : switch to a new year= ', nyear
129            WRITE( sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear
130            sd(jf)%nyear = nyear
131            CALL iom_open( sd(jf)%clname, sd(jf)%num )
132            !
133            IF( sd(jf)%ln_tint ) THEN       ! no record index change, update record time
134               sd(jf)%rec_b(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 )
135               sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim,  0 )
136               sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 )   
137            ELSE                            ! ???
138               sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 )
139               sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim,  0 )   
140            ENDIF
141            !
142         ENDIF
143         !
144         !                                            ! ============================= !
145         !                                            !   Read / Update input fields  !
146         !                                            ! ============================= !
147         !
148         ! current record index
149         zrec_kt(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) 
150         !
151         ! read next record (if required)
152         IF( zrec_kt(1) == sd(jf)%rec_a(1) ) THEN 
153            !
154            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap
155               sd(jf)%rec_b = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 )   ! record index & time
156!CDIR COLLAPSE
157               sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2)                                    ! record field
158            ENDIF
159            !
160            sd(jf)%rec_n(:) = zrec_kt(:)      ! update now record index & time
161            !                                 ! read record
162            CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) )
163            !
164            !                                 ! after record index & time
165            sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 )   
166            !
167            !                                 ! control print
168            IF( sd(jf)%ln_tint ) THEN
169            IF(lwp .AND. nitend - nit000 <= 100 )   WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ),   &
170            & ' d/M=', nday,nmonth,' rec bna:', INT(sd(jf)%rec_b(1)), INT(sd(jf)%rec_n(1)),INT(sd(jf)%rec_a(1)), &
171            & ' zrec bna', sd(jf)%rec_b(2)/rday, sd(jf)%rec_n(2)/rday, sd(jf)%rec_a(2)/rday
172            ELSE
173            IF(lwp .AND. nitend - nit000 <= 100 )   WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ),   &
174            &   ' D/M=', nday,nmonth, ' record :', INT(sd(jf)%rec_n(1)),     &
175            &   ' at', sd(jf)%rec_n(2)/rday, 'day,  next rec', INT(sd(jf)%rec_a(1))
176            ENDIF
177         ENDIF
178
179         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN                              !** update field at each kn_fsbc time-step
180            !
181            IF( sd(jf)%ln_tint ) THEN                                       !* linear time interpolated field
182               zt =  ( rsec_year - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_n(2) - sd(jf)%rec_b(2) )
183      !CDIR COLLAPSE
184               sd(jf)%fnow(:,:) = ( 1. - zt ) * sd(jf)%fdta(:,:,1) + zt * sd(jf)%fdta(:,:,2)
185            ELSE
186      !CDIR COLLAPSE
187               sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)                        !* piecewise constant field
188            ENDIF
189            !
190         ENDIF
191         !
192         !                                         ! ======================== !
193         IF( kt == nitend ) THEN                   !  Close the input files   !
194            !                                      ! ======================== !
195            CALL iom_close( sd(jf)%num )
196         ENDIF
197         !                                      ! ===================== !
198      END DO                                    !  END LOOP OVER FIELD  !
199      !                                         ! ===================== !
200   END SUBROUTINE fld_read
201
202
203   FUNCTION fld_rec( pfreq, ld_tint, kclim, kshift )   RESULT( prec_info )
204      !!---------------------------------------------------------------------
205      !!                    ***  ROUTINE fld_rec  ***
206      !!
207      !! ** Purpose :   provide
208      !!
209      !! ** Method  :   
210      !!----------------------------------------------------------------------
211      REAL(wp), INTENT(in)   ::   pfreq       ! record frequency (>0 in hours, <0 in months)
212      LOGICAL , INTENT(in)   ::   ld_tint     ! time interpolation flag (T/F)
213      INTEGER , INTENT(in)   ::   kclim       ! climatology flag (=0/1)
214      INTEGER , INTENT(in)   ::   kshift      ! record shift
215      REAL(wp), DIMENSION(2) ::   prec_info   ! 1: file record + kshift
216      !                                       ! 2: associated time [sec] centered at half the record frequency
217      !!
218      INTEGER  ::   iendh, irec
219      REAL(wp) ::   zrec
220      !!----------------------------------------------------------------------
221      !
222      IF( pfreq == -12. ) THEN      ! monthly data
223         !
224         iendh = 12                        ! 12 records per year
225         IF( ld_tint) THEN                 ! time interpolation, shift by 1/2 record
226            zrec  = REAL( nday     ) / REAL( nmonth_len(nmonth) ) + 0.5
227         ELSE
228            zrec  = REAL( nday - 1 ) / REAL( nmonth_len(nmonth) )
229         ENDIF
230         irec = nmonth + kshift + INT( zrec )   ! record index (from 0 to 13)
231         zrec = rmonth_half(irec)               ! record time (second since 00h, Jan. 1st)
232         !
233      ELSE                          ! high frequency data (pfreq in hours)
234         !
235         iendh = INT( 365 * 24 / pfreq )   ! iendh records per year
236         IF( ld_tint ) THEN                ! time interpolation, shift by 1/2 record
237            zrec = rsec_year / ( pfreq * 3600. ) + 0.5 
238         ELSE                 
239            zrec = rsec_year / ( pfreq * 3600. )     
240         ENDIF     
241         irec = 1      + kshift + INT( zrec )                          ! record index (from 0 to iendh+1)
242         zrec = - 0.5 * 3600. * pfreq + 3600. * pfreq * REAL( irec )   ! record time (second since 00h, Jan. 1st)
243         !
244      ENDIF
245      !
246      !                             ! adjuste the record index (climatology or interannual)
247      IF( kclim /= 1 )   THEN
248         irec = irec + 1                                          ! interannual: additional first record
249      ELSE                     
250         IF( irec  ==         0 )   irec  =            iendh      ! climatology: record 0 is the last record (iendh)
251         IF( irec  >= iendh + 1 )   irec  = MOD( irec, iendh )    ! climatology: apply a modulo iendh
252      ENDIF
253      !
254      prec_info(1) = REAL( irec, wp )
255      prec_info(2) = zrec
256      !
257   END FUNCTION fld_rec
258
259   !!======================================================================
260END MODULE fldread
Note: See TracBrowser for help on using the repository browser.