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 tags/nemo_dev_x4/NEMO/OPA_SRC/SBC – NEMO

source: tags/nemo_dev_x4/NEMO/OPA_SRC/SBC/flx_coupled_noice.h90 @ 126

Last change on this file since 126 was 126, checked in by cvs2svn, 20 years ago

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