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

source: trunk/NEMO/OPA_SRC/SBC/tau_forced_monthly.h90 @ 392

Last change on this file since 392 was 392, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

  • add agrif to dynspg_flt_jki.F90
  • cosmetic change of key_AGRIF in key_agrif
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.2 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                ***  tau_forced_monthly.h90  ***
3   !!----------------------------------------------------------------------
4
5   !!----------------------------------------------------------------------
6   !!   tau     : update the surface wind stress - monthly fields in NetCDF
7   !!             file.
8   !!----------------------------------------------------------------------
9   !! * local modules variables
10   INTEGER ::   &
11      numtau,   &  ! logical unit for the i-component of the wind data
12      numtav,   &  ! logical unit for the j-component of the wind data
13      ntau1, ntau2  ! index of the first and second record used
14
15   CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields
16      cl_taux,  & ! generic name of the i-component monthly NetCDF file
17      cl_tauy     ! generic name of the j-component monthly NetCDF file
18
19   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
20      taux_dta,    &  ! i- and j-components of the surface stress (Pascal)
21      tauy_dta        ! at 2 consecutive months in the (i,j) referential
22   !!----------------------------------------------------------------------
23   !!   OPA 9.0 , LOCEAN-IPSL (2005)
24   !! $Header$
25   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30   SUBROUTINE tau( kt )
31      !!---------------------------------------------------------------------
32      !!                  ***  ROUTINE tau  ***
33      !!             
34      !! ** Purpose :   provide to the ocean the stress at each time step
35      !!
36      !! ** Method  : - Read the 2 monthly surface stress components in NetCDF
37      !!      file at 2 consecutive time-steps
38      !!        They are given in the (i,j) referential
39      !!        The i-component is given at U-point (INTERP package)
40      !!        The j-component is given at V-point (INTERP package)
41      !!              - a linear time-interpolation is performed to provide the
42      !!      stress at the kt time-step.
43      !!
44      !!    CAUTION: never mask the surface stress field !
45      !!
46      !! ** Action :
47      !!        update at each time-step the two components of the surface
48      !!      stress in both (i,j) and geographical referencial
49      !!
50      !! History :
51      !!   4.0  !  91-03  (G. Madec)  Original code
52      !!   6.0  !  92-07  (M. Imbard)
53      !!   8.1  !  00-08  (D. Ludicone) adapted to ERS-NCEP
54      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
55      !!        !                     daily/monthly, forced/coupled form
56      !!----------------------------------------------------------------------
57      !! * Modules used
58      USE ioipsl       ! NetCDF library
59      !! * Arguments
60      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
61
62      !! * Local declarations
63      INTEGER, PARAMETER ::   jpmonth = 12
64      INTEGER ::   &
65         imois, iman, itime,   &
66         i15,   &
67         ipi, ipj, ipk
68      INTEGER, DIMENSION(jpmonth) ::   istep
69      REAL(wp) , DIMENSION(jpi,jpj)::  &
70         zlon  , &
71         zlat
72      REAL(wp) , DIMENSION(jpk)::  &
73         zlev
74      REAL(wp) ::   &
75         zsecond,   & ! ???
76         zdate0,    & ! ???
77         zxy          ! coefficient of the linear time interpolation
78      !!---------------------------------------------------------------------
79      cl_taux = 'taux_1m.nc'
80      cl_tauy = 'tauy_1m.nc'
81
82      ! -------------- !
83      ! Initialization !
84      ! -------------- !
85     
86      ! iman=number of dates in data file (12 for a year of monthly values)
87      iman  = INT( raamo )
88      itime = jpmonth
89      ipi   = jpiglo
90      ipj   = jpjglo
91      ipk   = jpk
92
93      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
94
95      imois = nmonth + i15 - 1
96      IF( imois == 0 ) imois = iman
97
98
99      ! -------------------- !
100      ! First call kt=nit000 !
101      ! -------------------- !
102
103      IF( kt == nit000 ) THEN
104         ntau1 = 0
105         IF(lwp) WRITE(numout,*)
106         IF(lwp) WRITE(numout,*) ' tau    : MONTHLY climatological wind stress (NetCDF files)'
107         IF(lwp) WRITE(numout,*) ' ~~~    '
108         
109         ! title, dimensions and tests
110
111#if defined key_agrif
112      if ( .NOT. Agrif_Root() ) then
113         cl_taux = TRIM(Agrif_CFixed())//'_'//TRIM(cl_taux)
114      endif
115#endif
116         
117         CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid
118                        .FALSE., ipi   , ipj, ipk   ,        &
119                        zlon , zlat  , zlev   , itime,       &
120                        istep, zdate0, zsecond, numtau )
121         
122         IF( itime /= jpmonth ) THEN
123            IF(lwp) WRITE(numout,cform_err)
124            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_taux
125            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth
126            nstop = nstop + 1
127         ENDIF
128         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
129            IF(lwp) WRITE(numout,cform_err)
130            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_taux
131            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
132            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
133            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
134            nstop = nstop + 1
135         ENDIF
136#if defined key_agrif
137      if ( .NOT. Agrif_Root() ) then
138         cl_tauy = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tauy)
139      endif
140#endif
141         CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid
142                        .FALSE., ipi   , ipj, ipk   ,        &
143                        zlon , zlat  , zlev   , itime,       &
144                        istep, zdate0, zsecond, numtav )
145
146         IF( itime /= jpmonth ) THEN         
147            IF(lwp) WRITE(numout,cform_err)
148            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_tauy
149            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth
150            nstop = nstop + 1
151         ENDIF
152         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN
153            IF(lwp) WRITE(numout,cform_err)
154            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_tauy
155            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
156            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
157            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
158            nstop = nstop + 1
159         ENDIF
160      ENDIF
161     
162      ! ----------------- !
163      ! Read monthly file !
164      ! ----------------- !
165
166      IF( kt == nit000 .OR. imois /= ntau1 ) THEN
167
168         ! Calendar computation
169         ntau1 = imois          ! index of the first record
170         ntau2 = ntau1 + 1      ! index of the last  record
171         ntau1 = MOD( ntau1, iman )
172         IF( ntau1 == 0 ) ntau1 = iman
173         ntau2 = MOD( ntau2, iman )
174         IF( ntau2 == 0 ) ntau2 = iman
175         IF(lwp) WRITE(numout,*) 'first month used ntau1 = ', ntau1
176         IF(lwp) WRITE(numout,*) 'last  month used ntau2 = ', ntau2
177
178         ! Read the corresponding 2 monthly stress data
179         ! ntau1
180         CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt
181            jpidta,jpjdta,1,jpmonth,ntau1,   &
182            ntau1,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,1) )
183         CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt
184            jpidta,jpjdta,1,jpmonth,ntau1,   &
185            ntau1,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,1) )
186         ! ntau2
187         CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt
188            jpidta,jpjdta,1,jpmonth,ntau2,   &
189            ntau2,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,2) )
190         CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt
191            jpidta,jpjdta,1,jpmonth,ntau2,   &
192            ntau2,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,2) )
193         
194         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
195            WRITE(numout,*)
196            WRITE(numout,*) ' monthly stress read'
197            WRITE(numout,*)
198            WRITE(numout,*) ' month: ', ntau1, '  taux: 1 multiply by ', 1.
199            CALL prihre( taux_dta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
200            WRITE(numout,*)
201            WRITE(numout,*) ' month: ', ntau2, '  tauy: 2 multiply by ', 1.
202            CALL prihre( tauy_dta(:,:,2), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
203         ENDIF
204
205         CALL FLUSH(numout)
206      ENDIF
207
208      ! ------------------------------- !
209      ! linear time interpolation at kt !
210      ! ------------------------------- !
211
212      ! zxy : coefficient for linear interpolation in time
213
214      zxy = FLOAT( nday ) / FLOAT( nobis(ntau1) ) + 0.5 - i15
215
216      taux(:,:) = (1.-zxy) * taux_dta(:,:,1) + zxy * taux_dta(:,:,2)
217      tauy(:,:) = (1.-zxy) * tauy_dta(:,:,1) + zxy * tauy_dta(:,:,2)
218
219      ! Save components
220
221      tauxg(:,:) = taux(:,:)
222      tauyg(:,:) = tauy(:,:)
223
224      CALL FLUSH(numout)
225
226      ! ------------------- !
227      ! Last call kt=nitend !
228      ! ------------------- !
229
230      ! Closing of the 2 files (required in mpp)
231      IF( kt == nitend ) THEN
232          CALL flinclo(numtau)
233          CALL flinclo(numtav)
234      ENDIF
235
236   END SUBROUTINE tau
Note: See TracBrowser for help on using the repository browser.