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

source: trunk/NEMO/OPA_SRC/SBC/tau_coupled_ice.h90 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.3 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                   ***  tau_coupled_ice.h90  ***
3   !!----------------------------------------------------------------------
4
5   !!----------------------------------------------------------------------
6   !!   tau     :   update the surface stress - coupled case with LIM
7   !!               sea-ice model
8   !!----------------------------------------------------------------------
9   !!----------------------------------------------------------------------
10   !!   OPA 9.0 , LOCEAN-IPSL (2005)
11   !! $Header$
12   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
13   !!----------------------------------------------------------------------
14
15CONTAINS
16
17   SUBROUTINE tau( kt )
18      !!---------------------------------------------------------------------
19      !!                    ***  ROUTINE tau  ***
20      !! 
21      !! ** Purpose :   provide to the ocean the stress at each time step
22      !!
23      !! ** Method  :   Coupled case with LIM sea-ice model
24      !!      Read wind stress from a coupled Atmospheric model
25      !!      - horizontal interpolation is done in OASIS
26      !!        They are given in the 3D referential
27      !!      (3 components at both U- and V-points)
28      !!
29      !!    CAUTION: never mask the surface stress field !
30      !!
31      !! ** Action  :   update at each time-step the two components of the
32      !!                surface stress in both (i,j) and geographical ref.
33      !!
34      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
35      !!
36      !! History :
37      !!   7.0  !  94-03  (L. Terray)  Original code
38      !!        !  96-07  (Laurent TERRAY)  OASIS 2 Version
39      !!        !  96-11  (Eric Guilyardi) horizontal interpolation
40      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard) OASIS2.2
41      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
42      !!----------------------------------------------------------------------
43      !! * Modules used
44      USE ioipsl                ! NetCDF library
45      USE cpl_oce               ! coupled ocean-atmosphere variables
46      USE geo2ocean             ! ???
47
48      !! * Arguments
49      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
50
51      !! * Local declarations
52      INTEGER :: ji,jj,jf
53      INTEGER :: itm1,isize,iflag,info,inuread,index
54!      INTEGER :: icpliter
55      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
56         ztauxxu, ztauyyu, ztauzzu,   &  ! 3 components of the wind stress
57         ztauxxv, ztauyyv, ztauzzv       ! at U- and V-points
58      REAL(wp), DIMENSION(jpi,jpj) ::   &
59         ztauxx, ztauyy, ztauzz,      &  ! ???
60         ztauxg, ztauyg, ztauver         !
61
62! netcdf outputs
63
64      CHARACTER (len=80) ::   clcpltnam
65      INTEGER :: nhoridct, nidct
66      INTEGER ,DIMENSION(jpi*jpj) :: ndexct
67      SAVE nhoridct,nidct,ndexct
68      LOGICAL, SAVE :: lfirstt=.true.
69      REAL(wp) ::   zjulian
70
71! Addition for SIPC CASE
72      CHARACTER (len=3) ::   clmodinf      ! Header or not
73!      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any
74!      INTEGER ,DIMENSION(3) ::  infos          ! infos in the field brick, if any
75!!---------------------------------------------------------------------
76
77! 0. Initialization
78!------------------
79
80      isize = jpiglo * jpjglo
81      itm1 = ( kt - nit000 + 1 ) - 1
82
83! initialisation for output
84
85      IF( lfirstt ) THEN
86          lfirstt = .FALSE.
87          ndexct(:) = 0
88          clcpltnam = "cpl_oce_tau"
89
90! Compute julian date from starting date of the run
91          CALL ymds2ju( nyear    , nmonth, nday , 0.e0  , zjulian )
92          CALL histbeg( clcpltnam, jpiglo, glamt, jpjglo, gphit,   &
93             1, jpiglo, 1, jpjglo, 0, zjulian, rdt, nhoridct, nidct)
94! no vertical axis
95          CALL histdef( nidct, 'taux'  , 'taux'  , "-", jpi, jpj, nhoridct,   &
96             1, 1, 1, -99, 32, "inst", rdt, rdt )
97          CALL histdef( nidct, 'tauy'  , 'tauy'  , "-", jpi, jpj, nhoridct,   &
98             1, 1, 1, -99, 32, "inst", rdt, rdt )
99          CALL histdef( nidct, 'tauxeu', 'tauxeu', "-", jpi, jpj, nhoridct,   &
100             1, 1, 1, -99, 32, "inst", rdt, rdt )
101          CALL histdef( nidct, 'tauynu', 'tauynu', "-", jpi, jpj, nhoridct,   &
102             1, 1, 1, -99, 32, "inst", rdt, rdt )
103          CALL histdef( nidct, 'tauzzu', 'tauzzu', "-", jpi, jpj, nhoridct,   &
104             1, 1, 1, -99, 32, "inst", rdt, rdt )
105          CALL histdef( nidct, 'tauxev', 'tauxev', "-", jpi, jpj, nhoridct,   &
106             1, 1, 1, -99, 32, "inst", rdt, rdt )
107          CALL histdef( nidct, 'tauynv', 'tauynv', "-", jpi, jpj, nhoridct,   &
108             1, 1, 1, -99, 32, "inst", rdt, rdt )
109          CALL histdef( nidct, 'tauzzv', 'tauzzv', "-", jpi, jpj, nhoridct,   &
110             1, 1, 1, -99, 32, "inst", rdt, rdt )
111
112          DO jf = 1, ntauc2o
113            CALL histdef( nidct, cpl_readtau(jf), cpl_readtau(jf),   &
114               "-", jpi, jpj, nhoridct,   &
115               1, 1, 1, -99, 32, "inst", rdt, rdt )
116          END DO
117
118          CALL histend(nidct)
119
120      ENDIF
121
122! 1. Reading wind stress from coupler
123! -----------------------------------
124
125      IF( MOD(kt,nexco) == 1 ) THEN
126
127! Test what kind of message passing we are using
128
129          IF( cchan == 'PIPE' ) THEN
130
131! UNIT number for fields
132
133              inuread = 99
134
135! exchanges from to atmosphere=CPL to ocean
136
137              DO jf = 1, ntauc2o
138!                CALL PIPE_Model_Recv(cpl_readtau(jf), icpliter, numout)
139                OPEN (inuread, FILE=cpl_f_readtau(jf), FORM='UNFORMATTED')
140                IF( jf == 1 ) CALL locread(cpl_readtau(jf), ztauxxu,isize,inuread,iflag,numout)
141                IF( jf == 2 ) CALL locread(cpl_readtau(jf), ztauyyu,isize,inuread,iflag,numout)
142                IF( jf == 3 ) CALL locread(cpl_readtau(jf), ztauzzu,isize,inuread,iflag,numout)
143                IF( jf == 4 ) CALL locread(cpl_readtau(jf), ztauxxv,isize,inuread,iflag,numout)
144                IF( jf == 5 ) CALL locread(cpl_readtau(jf), ztauyyv,isize,inuread,iflag,numout)
145                IF( jf == 6 ) CALL locread(cpl_readtau(jf), ztauyyv,isize,inuread,iflag,numout)
146                CLOSE ( inuread )
147              END DO
148
149          ELSE IF( cchan == 'SIPC' ) THEN
150
151!         Define IF a header must be encapsulated within the field brick :
152              clmodinf = 'NOT'   ! as $MODINFO in namcouple 
153!
154!         reading of input field zonal wind stress SOZOTAUX
155
156              index = 1
157!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztaux)
158
159!         reading of input field meridional wind stress SOZOTAU2 (at v point)
160
161              index = 2
162!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztaux2)
163
164!         reading of input field zonal wind stress SOMETAUY
165
166              index = 3
167!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztauy)
168
169!         reading of input field meridional wind stress SOMETAU2 (at u point)
170
171              index = 4
172!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztauy2)
173!
174
175          ELSE IF ( cchan == 'CLIM' ) THEN
176
177              WRITE (numout,*) 'Reading wind stress from coupler ', kt
178
179! exchanges from atmosphere=CPL to ocean
180
181              DO jf = 1, ntauc2o
182                IF( jf == 1 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauxxu,info)
183                IF( jf == 2 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauyyu,info)
184                IF( jf == 3 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauzzu,info)
185                IF( jf == 4 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauxxv,info)
186                IF( jf == 5 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauyyv,info)
187                IF( jf == 6 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauzzv,info)
188                IF( info /= CLIM_Ok) THEN
189                    WRITE(numout,*)'Pb in reading ', cpl_readtau(jf), jf
190                    WRITE(numout,*)'Couplage itm1 is = ',itm1
191                    WRITE(numout,*)'CLIM error code is = ', info
192                    WRITE(numout,*)'STOP in Fromcpl'
193                    STOP 'tau.coupled.h90'
194                ENDIF
195              END DO
196          ENDIF
197
198          DO jf = 1, ntauc2o
199            IF( jf == 1 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauxxu,jpi*jpj,ndexct)
200            IF( jf == 2 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauyyu,jpi*jpj,ndexct)
201            IF( jf == 3 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauzzu,jpi*jpj,ndexct)
202            IF( jf == 4 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauxxv,jpi*jpj,ndexct)
203            IF( jf == 5 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauyyv,jpi*jpj,ndexct)
204            IF( jf == 6 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauzzv,jpi*jpj,ndexct)
205          END DO
206
207          CALL histsync(nidct)
208
209! 2. CHANGING DATA GRID COORDINATES --> GLOBAL GRID COORDINATES
210! -------------------------------------------------------------
211! On u grid
212          DO jj = 1, jpj
213            DO ji = 1, jpi
214              ztauxx(ji,jj) = ztauxxu( mig(ji), mjg(jj) )
215              ztauyy(ji,jj) = ztauyyu( mig(ji), mjg(jj) )
216              ztauzz(ji,jj) = ztauzzu( mig(ji), mjg(jj) )
217            END DO
218          END DO
219
220          CALL geo2oce( ztauxx, ztauyy, ztauzz, 'u', glamu, gphiu, tauxg, ztauyg, ztauver )
221
222          CALL histwrite( nidct, 'tauxeu', kt , tauxg  , jpi*jpj, ndexct )
223          CALL histwrite( nidct, 'tauynu', kt , ztauyg , jpi*jpj, ndexct )
224          CALL histwrite( nidct, 'tauzzu', kt , ztauver, jpi*jpj, ndexct )
225
226! On v grid
227          DO jj = 1, jpj
228            DO ji = 1, jpi
229              ztauxx(ji,jj) = ztauxxv( mig(ji), mjg(jj) )
230              ztauyy(ji,jj) = ztauyyv( mig(ji), mjg(jj) )
231              ztauzz(ji,jj) = ztauzzv( mig(ji), mjg(jj) )
232            END DO
233          END DO
234
235          CALL geo2oce( ztauxx, ztauyy, ztauzz, 'v', glamv, gphiv, ztauxg, tauyg, ztauver )
236
237          CALL histwrite( nidct, 'tauxev', kt , ztauxg , jpi*jpj, ndexct )
238          CALL histwrite( nidct, 'tauynv', kt , tauyg  , jpi*jpj, ndexct )
239          CALL histwrite( nidct, 'tauzzv', kt , ztauver, jpi*jpj, ndexct )
240
241
242          CALL repcmo( tauxg, ztauyg, ztauxg, tauyg, taux, tauy, kt )
243
244! sortie des composantes de vents : tauxn tauye
245
246          CALL histwrite( nidct, 'taux', kt , taux, jpi*jpj, ndexct )
247          CALL histwrite( nidct, 'tauy', kt , tauy, jpi*jpj, ndexct )
248          CALL histsync( nidct )
249          IF( nitend-kt < nexco ) CALL histclo( nidct )
250
251      ENDIF
252
253   END SUBROUTINE tau
Note: See TracBrowser for help on using the repository browser.