model/src/ini_forcing.F

212a8d049e Ed H*0001 #include "PACKAGES_CONFIG.h"
1dbaea09ee Chri*0002 #include "CPP_OPTIONS.h"
924557e60a Chri*0003
9366854e02 Chri*0004 CBOP
                0005 C     !ROUTINE: INI_FORCING
                0006 C     !INTERFACE:
924557e60a Chri*0007       SUBROUTINE INI_FORCING( myThid )
                0008
9366854e02 Chri*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
d197c88195 Jean*0011 C     | SUBROUTINE INI_FORCING
                0012 C     | o Set model initial forcing fields.
9366854e02 Chri*0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
924557e60a Chri*0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
a5e98ae15f Jean*0023 #include "SURFACE.h"
924557e60a Chri*0024 #include "FFIELDS.h"
                0025
9366854e02 Chri*0026 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*0027 C     == Routine arguments ==
983485b08a Jean*0028 C     myThid :: my Thread Id number
924557e60a Chri*0029       INTEGER myThid
                0030
9366854e02 Chri*0031 C     !LOCAL VARIABLES:
924557e60a Chri*0032 C     == Local variables ==
983485b08a Jean*0033 C     bi,bj  :: Tile indices
                0034 C     i, j   :: Loop counters
924557e60a Chri*0035       INTEGER bi, bj
d197c88195 Jean*0036       INTEGER  i, j
9366854e02 Chri*0037 CEOP
924557e60a Chri*0038
d197c88195 Jean*0039 C-    Initialise all arrays in common blocks
d067a44b7e Jean*0040 C     <-- moved to new S/R INI_FFIELDS
d197c88195 Jean*0041
28659cf1dc Patr*0042       DO bj = myByLo(myThid), myByHi(myThid)
                0043        DO bi = myBxLo(myThid), myBxHi(myThid)
4eb48150b4 Jean*0044         DO j=1-OLy,sNy+OLy
                0045          DO i=1-OLx,sNx+OLx
d197c88195 Jean*0046           IF ( doThetaClimRelax .AND.
                0047      &         ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
                0048            lambdaThetaClimRelax(i,j,bi,bj) = 1. _d 0/tauThetaClimRelax
28659cf1dc Patr*0049           ELSE
d197c88195 Jean*0050            lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
28659cf1dc Patr*0051           ENDIF
                0052           IF ( doSaltClimRelax .AND.
d197c88195 Jean*0053      &         ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
                0054            lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
28659cf1dc Patr*0055           ELSE
d197c88195 Jean*0056            lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
28659cf1dc Patr*0057           ENDIF
                0058          ENDDO
                0059         ENDDO
                0060        ENDDO
                0061       ENDDO
d197c88195 Jean*0062
                0063 C-    every-one waits before master thread loads from file
3365bdc872 Jean*0064 C     this is done within IO routines => no longer needed
                0065 c     _BARRIER
d197c88195 Jean*0066
ab42872a05 Alis*0067       IF ( zonalWindFile .NE. ' '  ) THEN
                0068        CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
                0069       ENDIF
                0070       IF ( meridWindFile .NE. ' '  ) THEN
                0071        CALL READ_FLD_XY_RS( meridWindFile, ' ', fv, 0, myThid )
                0072       ENDIF
                0073       IF ( surfQFile .NE. ' '  ) THEN
                0074        CALL READ_FLD_XY_RS( surfQFile, ' ', Qnet, 0, myThid )
2d2cc93d4f Jean*0075       ELSEIF ( surfQnetFile .NE. ' '  ) THEN
                0076        CALL READ_FLD_XY_RS( surfQnetFile, ' ', Qnet, 0, myThid )
ab42872a05 Alis*0077       ENDIF
                0078       IF ( EmPmRfile .NE. ' '  ) THEN
                0079        CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
62fd6ae4e5 Jean*0080 c      IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
b5f408f39d Jean*0081 C-     EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
                0082         DO bj = myByLo(myThid), myByHi(myThid)
                0083          DO bi = myBxLo(myThid), myBxHi(myThid)
4eb48150b4 Jean*0084           DO j=1-OLy,sNy+OLy
                0085            DO i=1-OLx,sNx+OLx
b5f408f39d Jean*0086             EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)*rhoConstFresh
                0087            ENDDO
                0088           ENDDO
                0089          ENDDO
                0090         ENDDO
62fd6ae4e5 Jean*0091 c      ENDIF
ab42872a05 Alis*0092       ENDIF
1e273d1bf5 Jean*0093       IF ( saltFluxFile .NE. ' '  ) THEN
                0094        CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
                0095       ENDIF
ab42872a05 Alis*0096       IF ( thetaClimFile .NE. ' '  ) THEN
                0097        CALL READ_FLD_XY_RS( thetaClimFile, ' ', SST, 0, myThid )
                0098       ENDIF
                0099       IF ( saltClimFile .NE. ' '  ) THEN
                0100        CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
                0101       ENDIF
28659cf1dc Patr*0102       IF ( lambdaThetaFile .NE. ' '  ) THEN
d197c88195 Jean*0103        CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
28659cf1dc Patr*0104      &  lambdaThetaClimRelax, 0, myThid )
                0105       ENDIF
                0106       IF ( lambdaSaltFile .NE. ' '  ) THEN
d197c88195 Jean*0107        CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
28659cf1dc Patr*0108      &  lambdaSaltClimRelax, 0, myThid )
                0109       ENDIF
310851b9c0 Patr*0110 #ifdef SHORTWAVE_HEATING
                0111       IF ( surfQswFile .NE. ' '  ) THEN
                0112        CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
2d2cc93d4f Jean*0113        IF ( surfQFile .NE. ' '  ) THEN
                0114 C-     Qnet is now (after c54) the net Heat Flux (including SW)
d197c88195 Jean*0115         DO bj = myByLo(myThid), myByHi(myThid)
                0116          DO bi = myBxLo(myThid), myBxHi(myThid)
4e530425d3 Jean*0117           DO j=1-OLy,sNy+OLy
                0118            DO i=1-OLx,sNx+OLx
2d2cc93d4f Jean*0119             Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
4e530425d3 Jean*0120            ENDDO
2d2cc93d4f Jean*0121           ENDDO
                0122          ENDDO
4e530425d3 Jean*0123         ENDDO
2d2cc93d4f Jean*0124        ENDIF
310851b9c0 Patr*0125       ENDIF
                0126 #endif
395b093796 Mart*0127 #ifdef ATMOSPHERIC_LOADING
                0128       IF ( pLoadFile .NE. ' '  ) THEN
a8bcab80b7 Jean*0129        CALL READ_FLD_XY_RS( pLoadFile, ' ', pLoad, 0, myThid )
395b093796 Mart*0130       ENDIF
                0131 #endif
4eb48150b4 Jean*0132 #ifdef ALLOW_ADDFLUID
                0133       IF ( addMassFile .NE. ' ' ) THEN
                0134        CALL READ_FLD_XYZ_RL( addMassFile, ' ', addMass, 0, myThid )
                0135        CALL EXCH_XYZ_RL( addMass, myThid )
                0136       ENDIF
                0137 #endif /* ALLOW_ADDFLUID */
90929f8806 Patr*0138 #ifdef ALLOW_GEOTHERMAL_FLUX
                0139       IF ( geothermalFile .NE. ' ' ) THEN
d067a44b7e Jean*0140        CALL READ_FLD_XY_RS( geothermalFile, ' ',
90929f8806 Patr*0141      &  geothermalFlux, 0, myThid )
                0142        CALL EXCH_XY_RS( geothermalFlux, myThid )
                0143 # ifdef ALLOW_MONITOR
                0144        CALL MON_PRINTSTATS_RS(
                0145      &  1,geothermalFlux,'geothermalFlux',myThid)
                0146 # endif
                0147       ENDIF
                0148 #endif /* ALLOW_GEOTHERMAL_FLUX */
7e00d7e8f9 Jean*0149 #ifdef ALLOW_BALANCE_FLUXES
                0150       IF ( selectBalanceEmPmR.EQ.2 ) THEN
                0151 C-    set default weight to 1 (i.e., same correction as selectBalanceEmPmR=1 )
                0152        DO bj = myByLo(myThid), myByHi(myThid)
                0153         DO bi = myBxLo(myThid), myBxHi(myThid)
                0154          DO j=1-OLy,sNy+OLy
                0155           DO i=1-OLx,sNx+OLx
                0156             weight2BalanceFlx(i,j,bi,bj) = oneRS
                0157           ENDDO
                0158          ENDDO
                0159         ENDDO
                0160        ENDDO
                0161       ENDIF
                0162       IF ( wghtBalanceFile .NE. ' ' ) THEN
                0163        CALL READ_FLD_XY_RS( wghtBalanceFile, ' ',
                0164      &                      weight2BalanceFlx, 0, myThid )
                0165        CALL EXCH_XY_RS( weight2BalanceFlx, myThid )
                0166       ENDIF
                0167 #endif /* ALLOW_GEOTHERMAL_FLUX */
339a1b85b2 Patr*0168
023bfd6664 Jean*0169       CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
                0170       CALL EXCH_XY_RS( Qnet , myThid )
                0171       CALL EXCH_XY_RS( EmPmR, myThid )
                0172       CALL EXCH_XY_RS( saltFlux, myThid )
                0173       CALL EXCH_XY_RS( SST  , myThid )
                0174       CALL EXCH_XY_RS( SSS  , myThid )
                0175       CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
                0176       CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
395b093796 Mart*0177 #ifdef SHORTWAVE_HEATING
0320e25227 Mart*0178       CALL EXCH_XY_RS( Qsw  , myThid )
395b093796 Mart*0179 #endif
                0180 #ifdef ATMOSPHERIC_LOADING
0320e25227 Mart*0181       CALL EXCH_XY_RS( pLoad  , myThid )
a8bcab80b7 Jean*0182 C     CALL PLOT_FIELD_XYRS( pLoad, 'S/R INI_FORCING pLoad',1,myThid)
395b093796 Mart*0183 #endif
0127add478 Alis*0184 C     CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
                0185 C     CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)
c1dd0647a3 Chri*0186
924557e60a Chri*0187       RETURN
                0188       END