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

Last change on this file since 912 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113

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