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

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)
  • Property svn:keywords set to Id
File size: 9.6 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 daymod          ! calendar
32   USE fldread         ! read input fields
33   USE iom             ! IOM library
34   USE in_out_manager  ! I/O manager
35   USE lib_mpp         ! distribued memory computing library
36   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC sbc_flx       ! routine called by step.F90
42
43   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
44   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
45   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
46   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
47   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
48   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
49   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
50
51   REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3
52   REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56#  include "vectopt_loop_substitute.h90"
57   !!----------------------------------------------------------------------
58   !!   OPA 9.0 , LOCEAN-IPSL (2006)
59   !! $Id$
60   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
61   !!----------------------------------------------------------------------
62
63CONTAINS
64
65   SUBROUTINE sbc_flx( kt )
66      !!---------------------------------------------------------------------
67      !!                    ***  ROUTINE sbc_flx  ***
68      !!                   
69      !! ** Purpose :   provide at each time step the surface ocean fluxes
70      !!                (momentum, heat, freshwater and runoff)
71      !!
72      !! ** Method  : - READ each fluxes in NetCDF files:
73      !!                   i-component of the stress              utau  (N/m2)
74      !!                   j-component of the stress              vtau  (N/m2)
75      !!                   net downward heat flux                 qtot  (watt/m2)
76      !!                   net downward radiative flux            qsr   (watt/m2)
77      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
78      !!                Assumptions made:
79      !!                 - each file content an entire year (read record, not the time axis)
80      !!                 - first and last record are part of the previous and next year
81      !!                   (useful for time interpolation)
82      !!                 - the number of records is 2 + 365*24 / freqh(jf)
83      !!                   or 366 in leap year case
84      !!
85      !!      CAUTION :  - never mask the surface stress fields
86      !!                 - the stress is assumed to be in the mesh referential
87      !!                   i.e. the (i,j) referential
88      !!
89      !! ** Action  :   update at each time-step
90      !!              - utau  & vtau    : stress components in (i,j) referential
91      !!              - qns             : non solar heat flux
92      !!              - qsr             : solar heat flux
93      !!              - emp             : evap - precip (volume flux)
94      !!              - emps            : evap - precip (concentration/dillution)
95      !!----------------------------------------------------------------------
96      INTEGER, INTENT(in) ::   kt   ! ocean time step
97      !!
98      INTEGER  ::   ji, jj, jf   ! dummy indices
99      INTEGER  ::   ierror       ! return error code
100      REAL(wp) ::   zfact        ! temporary scalar
101      REAL(wp) ::   ztx, zty, ztau, zcoef
102      !!
103      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
104      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
105      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
106      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
107      !!---------------------------------------------------------------------
108      !                                         ! ====================== !
109      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
110         !                                      ! ====================== !
111         ! set file information
112         cn_dir = './'        ! directory in which the model is executed
113         ! ... default values (NB: frequency positive => hours, negative => months)
114         !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or !
115         !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  !
116         sn_utau = FLD_N(   'utau'  ,    24.    ,  'utau'    ,  .false.   , .false. ,   'yearly'  )
117         sn_vtau = FLD_N(   'vtau'  ,    24.    ,  'vtau'    ,  .false.   , .false. ,   'yearly'  )
118         sn_qtot = FLD_N(   'qtot'  ,    24.    ,  'qtot'    ,  .false.   , .false. ,   'yearly'  )
119         sn_qsr  = FLD_N(   'qsr'   ,    24.    ,  'qsr'     ,  .false.   , .false. ,   'yearly'  )
120         sn_emp  = FLD_N(   'emp'   ,    24.    ,  'emp'     ,  .false.   , .false. ,   'yearly'  )
121
122         REWIND ( numnam )               ! ... read in namlist namflx
123         READ   ( numnam, namsbc_flx ) 
124
125         ! store namelist information in an array
126         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
127         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
128         slf_i(jp_emp ) = sn_emp
129
130         ! set sf structure
131         ALLOCATE( sf(jpfld), STAT=ierror )
132         IF( ierror > 0 ) THEN   
133            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
134         ENDIF
135         DO ji= 1, jpfld
136            ALLOCATE( sf(ji)%fnow(jpi,jpj) )
137            ALLOCATE( sf(ji)%fdta(jpi,jpj,2) )
138         END DO
139
140
141         ! fill sf with slf_i and control print
142         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
143         !
144      ENDIF
145
146      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
147      !                                          ! input fields at the current time-step
148
149      ! set the ocean fluxes from read fields
150!CDIR COLLAPSE
151      DO jj = 1, jpj
152         DO ji = 1, jpi
153            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
154            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
155            qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj)
156            qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj)
157            emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
158         END DO
159      END DO
160
161      ! Initialization of emps (when no ice model)
162      emps(:,:) = emp (:,:) 
163
164      ! Estimation of wind speed as a function of wind stress ( |tau|=rhoa*Cd*|U|^2 )
165      zcoef = 0.5 / ( rhoa * cdrag ) 
166!CDIR NOVERRCHK
167      DO jj = 2, jpjm1
168!CDIR NOVERRCHK
169         DO ji = fs_2, fs_jpim1   ! vect. opt.
170            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
171            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
172            ztau = SQRT( ztx * ztx + zty * zty )
173            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
174         END DO
175      END DO
176      CALL lbc_lnk( wndm(:,:) , 'T', 1. )
177
178      ! control print (if less than 100 time-step asked)
179      IF( nitend-nit000 <= 100 .AND. lwp ) THEN
180         WRITE(numout,*) 
181         WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
182         DO jf = 1, jpfld
183            IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
184            IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
185            IF( jf == jp_emp                     )   zfact = 86400.
186            WRITE(numout,*) 
187            WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
188            CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
189         END DO
190         CALL FLUSH(numout)
191      ENDIF
192      !
193   END SUBROUTINE sbc_flx
194
195   !!======================================================================
196END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.