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

source: trunk/NEMO/OPA_SRC/SBC/flx_coupled_noice.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: 7.8 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                   ***  flx_coupled.h90  ***
3   !!----------------------------------------------------------------------
4   !!   flx          : define the thermohaline fluxes for the ocean in
5   !!                  coupled ocean/atmosphere case without sea-ice
6   !!----------------------------------------------------------------------
7   !!   OPA 9.0 , LOCEAN-IPSL (2005)
8   !! $Header$
9   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
10   !!----------------------------------------------------------------------
11
12CONTAINS
13
14   SUBROUTINE flx ( kt )
15      !!---------------------------------------------------------------------
16      !!                    ***  ROUTINE flx  ***
17      !!           
18      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
19      !!      to the ocean at each time step.
20      !!
21      !! ** Method  :   Read fluxes from a coupled Atmospheric model
22      !!
23      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
24      !!
25      !! History :
26      !!        !  92-06  (L.Terray)  Original code
27      !!   8.0  !  96-11  (E.Guilyardi)
28      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard)  OASIS2.2
29      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
30      !!----------------------------------------------------------------------
31      !! CAUTION : not checked for MPP  : J.M.M
32      !!----------------------------------------------------------------------
33      !! * Modules used
34      USE ioipsl                ! NetCDF IPSL library
35      USE cpl_oce               ! coupled ocean-atmosphere variables
36      USE flxrnf                ! ocean runoffs
37
38      !! * arguments
39      INTEGER, INTENT( in  ) ::   kt ! ocean time step
40
41      !! * Local declarations
42      INTEGER  ::   ji, jj, jf
43      INTEGER  ::   itm1, isize, iflag
44!      INTEGER  ::   icpliter
45      INTEGER  ::   info, inuread, index
46
47      REAL(wp) ::   zfacflx,zfacwat
48      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
49         znsolc  , zqsrc   ,   &  ! ???
50         zrunoff , zec     ,   &  !
51         zqsrice , zqsrwat ,   &  !
52         znsolice, znsolwat,   &  !
53         znsicedt, zevice  ,   &  !
54         zevwat  , zpliq   ,   &  !
55         zpsol   , zruncot ,   &  !
56         zrunriv
57
58      ! Addition for SIPC CASE
59!      CHARACTER (len=3) ::   clmodinf       ! Header or not
60!      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any
61      INTEGER infos(3)          ! infos in the field brick, if any
62      !!---------------------------------------------------------------------
63
64
65      ! Initialization
66      ! --------------
67
68      isize = jpiglo * jpjglo
69      itm1 = ( kt - nit000 + 1 ) - 1
70
71      ! caution, I presume that you have good UNIT system from coupler to OPA
72      ! that is :
73      ! watt/m2 for znsolc and zqsrc
74      ! kg/m2/s for evaporation, precipitation and runoff
75
76      zfacflx = 1.
77      zfacwat = 1.
78
79
80      ! Test if we couple at the current timestep
81      ! -----------------------------------------
82
83      IF( MOD( kt, nexco ) == 1 ) THEN
84
85         ! Test what kind of message passing we are using
86
87         IF(lwp) WRITE(numout,*)
88         IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
89         IF(lwp) WRITE(numout,*)
90         CALL FLUSH (numout)
91         
92         IF( cchan == 'PIPE' ) THEN
93            ! pipe mode
94
95            ! UNIT number for fields
96
97            inuread = 99
98
99            ! exchanges from to atmosphere=CPL to ocean
100
101            DO jf = 1, nflxc2o
102               ! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
103               OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
104               IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
105               IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc  ,isize,inuread,iflag,numout)
106               IF(jf == 3) CALL locread(cpl_readflx(jf),zec    ,isize,inuread,iflag,numout)
107               IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
108               CLOSE (inuread)
109            END DO
110
111         ELSE IF( cchan == 'SIPC' ) THEN
112            ! SIPC mode
113
114            ! Define IF a header must be encapsulated within the field brick :
115            clmodinf = 'NOT'   ! as $MODINFO in namcouple 
116
117            ! reading of input field non solar flux SONSHLDO
118            index = 1
119            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
120
121            ! reading of input field solar heat flux SOSHFLDO
122            index = 2
123            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc  )
124           
125            ! reading of input field water flux SOWAFLDO
126            index = 3
127            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec    )
128           
129            ! reading of input field runoff SORUNOFF
130            index = 4
131            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
132           
133         ELSE IF( cchan == 'CLIM' ) THEN
134            ! CLIM mode
135            IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
136            ! exchanges from atmosphere=CPL to ocean
137            DO jf = 1, nflxc2o
138               IF(jf ==  1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
139               IF(jf ==  2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
140               IF(jf ==  3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
141               IF(jf ==  4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
142               IF(jf ==  5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
143               IF(jf ==  6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice  ,info)
144               IF(jf ==  7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat  ,info)
145               IF(jf ==  8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq   ,info)
146               IF(jf ==  9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol   ,info)
147               IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
148               IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
149               IF( info /= CLIM_Ok ) THEN
150                  IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
151                  IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
152                  IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
153                  IF(lwp) WRITE(numout,*)'STOP in Flx'
154                  CALL abort('flx.coupled.h')
155               ENDIF
156            END DO
157         ENDIF
158         
159         ! copy in the subdomain
160
161         DO jj = 1, nlcj
162            DO ji = 1, nlci
163
164               !  qc = total flux add znsolc and zqsrc
165               
166               ! water fluxes input : P-E
167               
168               ! caution, I presume that you have the good UNIT system for OPA
169               ! that is :
170               ! watt/m2 for znsolc and zqsrc
171               ! mm/sec for evaporation, precipitation and runoff
172               ! to give ec and runoff in mm/day
173
174              qc    (ji,jj) = zfacflx * tmask(ji,jj,1) * (        znsolwat( mig(ji), mjg(jj) )   &
175                 &                                              + zqsrwat ( mig(ji), mjg(jj) )   )
176              qsrc  (ji,jj) = zfacflx * tmask(ji,jj,1) *          zqsrwat ( mig(ji), mjg(jj) )
177              ec    (ji,jj) = zfacwat * tmask(ji,jj,1) * ( - ABS( zevwat  ( mig(ji), mjg(jj) ) )   &
178                 &                                         + ABS( zpliq   ( mig(ji), mjg(jj) ) )   &
179                 &                                         + ABS( zpsol   ( mig(ji), mjg(jj) ) )   )
180              runoff(ji,jj) = zfacwat * tmask(ji,jj,1) *     ABS( zruncot ( mig(ji), mjg(jj) )   &
181                 &                                              + zrunriv ( mig(ji), mjg(jj) ) )
182           END DO
183        END DO
184
185      ENDIF
186
187   END SUBROUTINE flx
Note: See TracBrowser for help on using the repository browser.