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

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

  • Property svn:keywords set to Id
File size: 9.5 KB
RevLine 
[888]1MODULE sbcflx
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx  ***
4   !! Ocean forcing:  momentum, heat and freshwater flux formulation
5   !!=====================================================================
[2528]6   !! History :  1.0  !  2006-06  (G. Madec)  Original code
7   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
[888]8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   namflx   : flux formulation namlist
[2528]12   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
[888]13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
[2528]16   USE sbc_oce         ! surface boundary condition: ocean fields
17   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
[888]18   USE phycst          ! physical constants
19   USE fldread         ! read input fields
20   USE iom             ! IOM library
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distribued memory computing library
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC sbc_flx       ! routine called by step.F90
29
30   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
31   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
32   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
33   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
34   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
35   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
36   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
37
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
[1029]40#  include "vectopt_loop_substitute.h90"
[888]41   !!----------------------------------------------------------------------
[2528]42   !! NEMO/OPA 3.3 , NEMO-consortium (2010)
[1156]43   !! $Id$
[2715]44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[888]45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE sbc_flx( kt )
49      !!---------------------------------------------------------------------
50      !!                    ***  ROUTINE sbc_flx  ***
51      !!                   
52      !! ** Purpose :   provide at each time step the surface ocean fluxes
53      !!                (momentum, heat, freshwater and runoff)
54      !!
55      !! ** Method  : - READ each fluxes in NetCDF files:
56      !!                   i-component of the stress              utau  (N/m2)
57      !!                   j-component of the stress              vtau  (N/m2)
58      !!                   net downward heat flux                 qtot  (watt/m2)
59      !!                   net downward radiative flux            qsr   (watt/m2)
60      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
61      !!
62      !!      CAUTION :  - never mask the surface stress fields
[3625]63      !!                 - the stress is assumed to be in the (i,j) mesh referential
[888]64      !!
65      !! ** Action  :   update at each time-step
[1695]66      !!              - utau, vtau  i- and j-component of the wind stress
67      !!              - taum        wind stress module at T-point
68      !!              - wndm        10m wind module at T-point
[3625]69      !!              - qns         non solar heat flux including heat flux due to emp
70      !!              - qsr         solar heat flux
71      !!              - emp         upward mass flux (evap. - precip.)
72      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero
73      !!                            if ice is present (computed in limsbc(_2).F90)
[888]74      !!----------------------------------------------------------------------
75      INTEGER, INTENT(in) ::   kt   ! ocean time step
76      !!
[1695]77      INTEGER  ::   ji, jj, jf            ! dummy indices
78      INTEGER  ::   ierror                ! return error code
[4147]79      INTEGER  ::   ios                   ! Local integer output status for namelist read
[1695]80      REAL(wp) ::   zfact                 ! temporary scalar
81      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
82      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
83      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
[888]84      !!
85      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
86      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
87      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
88      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
89      !!---------------------------------------------------------------------
[2528]90      !
91      IF( kt == nit000 ) THEN                ! First call kt=nit000 
[888]92         ! set file information
[4147]93         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes
94         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901)
95901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in reference namelist', lwp )
96
97         REWIND( numnam_cfg )              ! Namelist namsbc_flx in configuration namelist : Files for fluxes
98         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 )
99902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist', lwp )
[4624]100         IF(lwm) WRITE ( numond, namsbc_flx ) 
[2528]101         !
102         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
103         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
104            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
105         !
106         !                                         ! store namelist information in an array
[888]107         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
108         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
109         slf_i(jp_emp ) = sn_emp
[2528]110         !
111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
[1133]112         IF( ierror > 0 ) THEN   
113            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
[888]114         ENDIF
[1200]115         DO ji= 1, jpfld
[2528]116            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
117            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
[1200]118         END DO
[2528]119         !                                         ! fill sf with slf_i and control print
[1133]120         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
[888]121         !
[3625]122         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90)
123         !
[888]124      ENDIF
125
[2528]126      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
127     
128      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
[888]129
[2528]130         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
131         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
132         ENDIF
[888]133!CDIR COLLAPSE
[2528]134         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
[1274]135            DO ji = 1, jpi
[2528]136               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
137               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
138               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
139               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
[1274]140            END DO
[888]141         END DO
[3625]142         !                                                        ! add to qns the heat due to e-p
143         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
144         !
[2528]145         !                                                        ! module of wind stress and wind speed at T-point
146         zcoef = 1. / ( zrhoa * zcdrag )
[1695]147!CDIR NOVERRCHK
148         DO jj = 2, jpjm1
149!CDIR NOVERRCHK
150            DO ji = fs_2, fs_jpim1   ! vect. opt.
151               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
152               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
153               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
154               taum(ji,jj) = zmod
155               wndm(ji,jj) = SQRT( zmod * zcoef )
156            END DO
157         END DO
158         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
159
[2528]160         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
[888]161            WRITE(numout,*) 
[1274]162            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
163            DO jf = 1, jpfld
164               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
165               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
166               IF( jf == jp_emp                     )   zfact = 86400.
167               WRITE(numout,*) 
168               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
169               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
170            END DO
171            CALL FLUSH(numout)
172         ENDIF
173         !
[888]174      ENDIF
175      !
176   END SUBROUTINE sbc_flx
177
178   !!======================================================================
179END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.