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

source: trunk/NEMO/OPA_SRC/SBC/sbcflx.F90 @ 1730

Last change on this file since 1730 was 1730, checked in by smasson, 14 years ago

use integer in calendar, see ticket:601

  • Property svn:keywords set to Id
File size: 9.7 KB
Line 
1MODULE sbcflx
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx  ***
4   !! Ocean forcing:  momentum, heat and freshwater flux formulation
5   !!=====================================================================
6   !! History :  9.0   !  06-06  (G. Madec)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   namflx   : flux formulation namlist
11   !!   sbc_flx  : flux formulation as ocean surface boundary condition
12   !!              (forced mode, fluxes read in NetCDF files)
13   !!----------------------------------------------------------------------
14   !! question diverses
15   !!  *   ajouter un test sur la division entier de freqh et rdttra ???
16   !!  **  ajoute dans namelist: 1 year forcing files
17   !!                         or forcing file starts at the begining of the run
18   !!  *** we assume that the forcing file start and end with the previous
19   !!      year last record and the next year first record (useful for
20   !!      time interpolation, required even if no time interp???)
21   !!  *   ajouter un test sur la division de la frequence en pas de temps
22   !!  ==> daymod ajout de nsec_year = number of second since the begining of the year
23   !!      assumed to be 0 at 0h january the 1st (i.e. 24h december the 31)
24   !!
25   !!  *** regrouper dtatem et dtasal
26   !!----------------------------------------------------------------------
27   USE oce             ! ocean dynamics and tracers
28   USE dom_oce         ! ocean space and time domain
29   USE sbc_oce         ! Surface boundary condition: ocean fields
30   USE phycst          ! physical constants
31   USE fldread         ! read input fields
32   USE iom             ! IOM library
33   USE in_out_manager  ! I/O manager
34   USE lib_mpp         ! distribued memory computing library
35   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC sbc_flx       ! routine called by step.F90
41
42   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
43   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
44   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
45   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
46   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
47   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
48   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
49
50   !! * Substitutions
51#  include "domzgr_substitute.h90"
52#  include "vectopt_loop_substitute.h90"
53   !!----------------------------------------------------------------------
54   !!   OPA 9.0 , LOCEAN-IPSL (2006)
55   !! $Id$
56   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58
59CONTAINS
60
61   SUBROUTINE sbc_flx( kt )
62      !!---------------------------------------------------------------------
63      !!                    ***  ROUTINE sbc_flx  ***
64      !!                   
65      !! ** Purpose :   provide at each time step the surface ocean fluxes
66      !!                (momentum, heat, freshwater and runoff)
67      !!
68      !! ** Method  : - READ each fluxes in NetCDF files:
69      !!                   i-component of the stress              utau  (N/m2)
70      !!                   j-component of the stress              vtau  (N/m2)
71      !!                   net downward heat flux                 qtot  (watt/m2)
72      !!                   net downward radiative flux            qsr   (watt/m2)
73      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
74      !!
75      !!      CAUTION :  - never mask the surface stress fields
76      !!                 - the stress is assumed to be in the mesh referential
77      !!                   i.e. the (i,j) referential
78      !!
79      !! ** Action  :   update at each time-step
80      !!              - utau, vtau  i- and j-component of the wind stress
81      !!              - taum        wind stress module at T-point
82      !!              - wndm        10m wind module at T-point
83      !!              - qns, qsr    non-slor and solar heat flux
84      !!              - emp, emps   evaporation minus precipitation
85      !!----------------------------------------------------------------------
86      INTEGER, INTENT(in) ::   kt   ! ocean time step
87      !!
88      INTEGER  ::   ji, jj, jf            ! dummy indices
89      INTEGER  ::   ierror                ! return error code
90      REAL(wp) ::   zfact                 ! temporary scalar
91      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
92      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
93      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
94      !!
95      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
96      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
97      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
98      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
99      !!---------------------------------------------------------------------
100      !                                         ! ====================== !
101      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
102         !                                      ! ====================== !
103         ! set file information
104         cn_dir = './'        ! directory in which the model is executed
105         ! ... default values (NB: frequency positive => hours, negative => months)
106         !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
107         !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
108         sn_utau = FLD_N(   'utau'  ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
109         sn_vtau = FLD_N(   'vtau'  ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
110         sn_qtot = FLD_N(   'qtot'  ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
111         sn_qsr  = FLD_N(   'qsr'   ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
112         sn_emp  = FLD_N(   'emp'   ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
113
114         REWIND ( numnam )               ! ... read in namlist namflx
115         READ   ( numnam, namsbc_flx ) 
116
117         ! store namelist information in an array
118         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
119         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
120         slf_i(jp_emp ) = sn_emp
121
122         ! set sf structure
123         ALLOCATE( sf(jpfld), STAT=ierror )
124         IF( ierror > 0 ) THEN   
125            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
126         ENDIF
127         DO ji= 1, jpfld
128            ALLOCATE( sf(ji)%fnow(jpi,jpj) )
129            ALLOCATE( sf(ji)%fdta(jpi,jpj,2) )
130         END DO
131
132
133         ! fill sf with slf_i and control print
134         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
135         !
136      ENDIF
137
138      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
139      !                                          ! input fields at the current time-step
140
141      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
142         !
143         ! set the ocean fluxes from read fields
144!CDIR COLLAPSE
145         DO jj = 1, jpj
146            DO ji = 1, jpi
147               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
148               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
149               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj)
150               qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj)
151               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
152            END DO
153         END DO
154         
155         ! module of wind stress and wind speed at T-point
156         zcoef = 1. / ( zrhoa * zcdrag ) 
157!CDIR NOVERRCHK
158         DO jj = 2, jpjm1
159!CDIR NOVERRCHK
160            DO ji = fs_2, fs_jpim1   ! vect. opt.
161               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
162               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
163               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
164               taum(ji,jj) = zmod
165               wndm(ji,jj) = SQRT( zmod * zcoef )
166            END DO
167         END DO
168         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
169
170         ! Initialization of emps (when no ice model)
171         emps(:,:) = emp (:,:) 
172                 
173         ! control print (if less than 100 time-step asked)
174         IF( nitend-nit000 <= 100 .AND. lwp ) THEN
175            WRITE(numout,*) 
176            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
177            DO jf = 1, jpfld
178               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
179               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
180               IF( jf == jp_emp                     )   zfact = 86400.
181               WRITE(numout,*) 
182               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
183               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
184            END DO
185            CALL FLUSH(numout)
186         ENDIF
187         !
188      ENDIF
189      !
190   END SUBROUTINE sbc_flx
191
192   !!======================================================================
193END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.