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 @ 699

Last change on this file since 699 was 699, checked in by smasson, 16 years ago

insert revision Id

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 5.7 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   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
15      taux_dta,    &  ! i- and j-components of the surface stress (Pascal)
16      tauy_dta        ! at 2 consecutive months in the (i,j) referential
17   !!----------------------------------------------------------------------
18   !!   OPA 9.0 , LOCEAN-IPSL (2005)
19   !! $Id$
20   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
21   !!----------------------------------------------------------------------
22
23CONTAINS
24
25   SUBROUTINE tau( kt )
26      !!---------------------------------------------------------------------
27      !!                  ***  ROUTINE tau  ***
28      !!             
29      !! ** Purpose :   provide to the ocean the stress at each time step
30      !!
31      !! ** Method  : - Read the 2 monthly surface stress components in NetCDF
32      !!      file at 2 consecutive time-steps
33      !!        They are given in the (i,j) referential
34      !!        The i-component is given at U-point (INTERP package)
35      !!        The j-component is given at V-point (INTERP package)
36      !!              - a linear time-interpolation is performed to provide the
37      !!      stress at the kt time-step.
38      !!
39      !!    CAUTION: never mask the surface stress field !
40      !!
41      !! ** Action :
42      !!        update at each time-step the two components of the surface
43      !!      stress in both (i,j) and geographical referencial
44      !!
45      !! History :
46      !!   4.0  !  91-03  (G. Madec)  Original code
47      !!   6.0  !  92-07  (M. Imbard)
48      !!   8.1  !  00-08  (D. Ludicone) adapted to ERS-NCEP
49      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
50      !!        !                     daily/monthly, forced/coupled form
51      !!----------------------------------------------------------------------
52      !! * Modules used
53      USE iom     
54      !! * Arguments
55      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
56
57      !! * Local declarations
58      INTEGER :: imois, iman, i15
59      REAL(wp) :: zxy          ! coefficient of the linear time interpolation
60      !!---------------------------------------------------------------------
61
62      ! -------------- !
63      ! Initialization !
64      ! -------------- !
65     
66      ! iman=number of dates in data file (12 for a year of monthly values)
67      iman  = INT( raamo )
68      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
69      imois = nmonth + i15 - 1
70      IF( imois == 0 ) imois = iman
71
72      ! -------------------- !
73      ! First call kt=nit000 !
74      ! -------------------- !
75
76      IF( kt == nit000 ) THEN
77         
78         ntau1 = 0   ! initialization
79         IF(lwp) THEN
80            WRITE(numout,*)
81            WRITE(numout,*) ' tau    : MONTHLY climatological wind stress (NetCDF files)'
82         ENDIF
83         CALL iom_open ( 'taux_1m.nc', numtau )
84         CALL iom_open ( 'tauy_1m.nc', numtav )
85         
86      ENDIF
87     
88      ! ----------------- !
89      ! Read monthly file !
90      ! ----------------- !
91
92      IF( kt == nit000 .OR. imois /= ntau1 ) THEN
93
94         ! Calendar computation
95         ntau1 = imois          ! index of the first record
96         ntau2 = ntau1 + 1      ! index of the last  record
97         ntau1 = MOD( ntau1, iman )
98         IF( ntau1 == 0 ) ntau1 = iman
99         ntau2 = MOD( ntau2, iman )
100         IF( ntau2 == 0 ) ntau2 = iman
101         IF(lwp) WRITE(numout,*) 'first month used ntau1 = ', ntau1
102         IF(lwp) WRITE(numout,*) 'last  month used ntau2 = ', ntau2
103
104         ! Read the corresponding 2 monthly stress data
105         ! ntau1
106         CALL iom_get ( numtau, jpdom_data, 'sozotaux', taux_dta(:,:,1), ntau1 )
107         CALL iom_get ( numtav, jpdom_data, 'sometauy', tauy_dta(:,:,1), ntau1 )
108
109         CALL iom_get ( numtau, jpdom_data, 'sozotaux', taux_dta(:,:,2), ntau2 )
110         CALL iom_get ( numtav, jpdom_data, 'sometauy', tauy_dta(:,:,2), ntau2 )
111         
112         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
113            WRITE(numout,*)
114            WRITE(numout,*) ' monthly stress read'
115            WRITE(numout,*)
116            WRITE(numout,*) ' month: ', ntau1, '  taux: 1 multiply by ', 1.
117            CALL prihre( taux_dta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
118            WRITE(numout,*)
119            WRITE(numout,*) ' month: ', ntau2, '  tauy: 2 multiply by ', 1.
120            CALL prihre( tauy_dta(:,:,2), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
121         ENDIF
122
123         CALL FLUSH(numout)
124
125      ENDIF
126
127      ! ------------------------------- !
128      ! linear time interpolation at kt !
129      ! ------------------------------- !
130
131      ! zxy : coefficient for linear interpolation in time
132
133      zxy = FLOAT( nday ) / FLOAT( nobis(ntau1) ) + 0.5 - i15
134
135      taux(:,:) = (1.-zxy) * taux_dta(:,:,1) + zxy * taux_dta(:,:,2)
136      tauy(:,:) = (1.-zxy) * tauy_dta(:,:,1) + zxy * tauy_dta(:,:,2)
137
138      ! ------------------- !
139      ! Last call kt=nitend !
140      ! ------------------- !
141
142      ! Closing of the 2 files (required in mpp)
143      IF( kt == nitend ) THEN
144          CALL iom_close(numtau)
145          CALL iom_close(numtav)
146      ENDIF
147
148   END SUBROUTINE tau
Note: See TracBrowser for help on using the repository browser.