/[MITgcm]/MITgcm/model/src/ini_forcing.F
ViewVC logotype

Diff of /MITgcm/model/src/ini_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.39 by cnh, Mon Nov 7 18:26:02 2005 UTC revision 1.54 by jmc, Wed Jan 14 18:40:55 2015 UTC
# Line 11  C     !INTERFACE: Line 11  C     !INTERFACE:
11    
12  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
13  C     *==========================================================*  C     *==========================================================*
14  C     | SUBROUTINE INI_FORCING                                      C     | SUBROUTINE INI_FORCING
15  C     | o Set model initial forcing fields.                        C     | o Set model initial forcing fields.
16  C     *==========================================================*  C     *==========================================================*
17  C     \ev  C     \ev
18    
# Line 23  C     === Global variables === Line 23  C     === Global variables ===
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
24  #include "PARAMS.h"  #include "PARAMS.h"
25  #include "GRID.h"  #include "GRID.h"
26    #include "SURFACE.h"
27  #include "FFIELDS.h"  #include "FFIELDS.h"
28    
29  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
30  C     == Routine arguments ==  C     == Routine arguments ==
31  C     myThid -  Number of this instance of INI_FORCING  C     myThid :: my Thread Id number
32        INTEGER myThid        INTEGER myThid
33    
34  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
35  C     == Local variables ==  C     == Local variables ==
36  C     bi,bj  - Loop counters  C     bi,bj  :: Tile indices
37  C     I,J  C     i, j   :: Loop counters
38        INTEGER bi, bj        INTEGER bi, bj
39        INTEGER  I,  J        INTEGER  i, j
40  CEOP  CEOP
41    
42        _BARRIER  C-    Initialise all arrays in common blocks
43    C     <-- moved to new S/R INI_FFIELDS
44    
45        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
46         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
47          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
48           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
49            fu              (i,j,bi,bj) = 0. _d 0            IF ( doThetaClimRelax .AND.
50            fv              (i,j,bi,bj) = 0. _d 0       &         ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
51            Qnet            (i,j,bi,bj) = 0. _d 0             lambdaThetaClimRelax(i,j,bi,bj) = 1. _d 0/tauThetaClimRelax
           EmPmR           (i,j,bi,bj) = 0. _d 0  
           saltFlux        (i,j,bi,bj) = 0. _d 0  
           SST             (i,j,bi,bj) = 0. _d 0  
           SSS             (i,j,bi,bj) = 0. _d 0  
           Qsw             (i,j,bi,bj) = 0. _d 0  
 #ifdef ATMOSPHERIC_LOADING  
           pload           (i,j,bi,bj) = 0. _d 0  
           sIceLoad        (i,j,bi,bj) = 0. _d 0  
 #endif  
           surfaceForcingU(i,j,bi,bj) = 0. _d 0  
           surfaceForcingV(i,j,bi,bj) = 0. _d 0  
           surfaceForcingT(i,j,bi,bj) = 0. _d 0  
           surfaceForcingS(i,j,bi,bj) = 0. _d 0  
           surfaceForcingTice(i,j,bi,bj) = 0. _d 0  
 #ifndef ALLOW_EXF  
           taux0           (i,j,bi,bj) = 0. _d 0  
           taux1           (i,j,bi,bj) = 0. _d 0  
           tauy0           (i,j,bi,bj) = 0. _d 0  
           tauy1           (i,j,bi,bj) = 0. _d 0  
           Qnet0           (i,j,bi,bj) = 0. _d 0  
           Qnet1           (i,j,bi,bj) = 0. _d 0  
           EmPmR0          (i,j,bi,bj) = 0. _d 0  
           EmPmR1          (i,j,bi,bj) = 0. _d 0  
           saltFlux0       (i,j,bi,bj) = 0. _d 0  
           saltFlux1       (i,j,bi,bj) = 0. _d 0  
           SST0            (i,j,bi,bj) = 0. _d 0  
           SST1            (i,j,bi,bj) = 0. _d 0  
           SSS0            (i,j,bi,bj) = 0. _d 0  
           SSS1            (i,j,bi,bj) = 0. _d 0  
 #ifdef SHORTWAVE_HEATING            
           Qsw0            (i,j,bi,bj) = 0. _d 0  
           Qsw1            (i,j,bi,bj) = 0. _d 0  
 #endif  
 #ifdef ATMOSPHERIC_LOADING  
           pload0          (i,j,bi,bj) = 0. _d 0  
           pload1          (i,j,bi,bj) = 0. _d 0  
 #endif  
 #endif  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 C  
       DO bj = myByLo(myThid), myByHi(myThid)  
        DO bi = myBxLo(myThid), myBxHi(myThid)  
         DO J=1-Oly,sNy+Oly  
          DO I=1-Olx,sNx+Olx  
           IF ( doThetaClimRelax .AND.  
      &         abs(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN  
            lambdaThetaClimRelax(I,J,bi,bj) = 1./tauThetaClimRelax  
52            ELSE            ELSE
53             lambdaThetaClimRelax(I,J,bi,bj) = 0.D0             lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
54            ENDIF            ENDIF
55            IF ( doSaltClimRelax .AND.            IF ( doSaltClimRelax .AND.
56       &         abs(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN       &         ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
57             lambdaSaltClimRelax(I,J,bi,bj) = 1./tauSaltClimRelax             lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
58            ELSE            ELSE
59             lambdaSaltClimRelax(I,J,bi,bj) = 0.D0             lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
60            ENDIF            ENDIF
61           ENDDO           ENDDO
62          ENDDO          ENDDO
63         ENDDO         ENDDO
64        ENDDO        ENDDO
65  C  
66        _BARRIER  C-    every-one waits before master thread loads from file
67        _BEGIN_MASTER(myThid)  C     this is done within IO routines => no longer needed
68    c     _BARRIER
69    
70        IF ( zonalWindFile .NE. ' '  ) THEN        IF ( zonalWindFile .NE. ' '  ) THEN
71         CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )         CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
72        ENDIF        ENDIF
# Line 126  C Line 80  C
80        ENDIF        ENDIF
81        IF ( EmPmRfile .NE. ' '  ) THEN        IF ( EmPmRfile .NE. ' '  ) THEN
82         CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )         CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
83    c      IF ( convertEmP2rUnit.EQ.mass2rUnit ) THEN
84    C-     EmPmR is now (after c59h) expressed in kg/m2/s (fresh water mass flux)
85            DO bj = myByLo(myThid), myByHi(myThid)
86             DO bi = myBxLo(myThid), myBxHi(myThid)
87              DO j=1-OLy,sNy+OLy
88               DO i=1-OLx,sNx+OLx
89                EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)*rhoConstFresh
90               ENDDO
91              ENDDO
92             ENDDO
93            ENDDO
94    c      ENDIF
95        ENDIF        ENDIF
96        IF ( saltFluxFile .NE. ' '  ) THEN        IF ( saltFluxFile .NE. ' '  ) THEN
97         CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )         CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
# Line 137  C Line 103  C
103         CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )         CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
104        ENDIF        ENDIF
105        IF ( lambdaThetaFile .NE. ' '  ) THEN        IF ( lambdaThetaFile .NE. ' '  ) THEN
106         CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',         CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
107       &  lambdaThetaClimRelax, 0, myThid )       &  lambdaThetaClimRelax, 0, myThid )
108        ENDIF        ENDIF
109        IF ( lambdaSaltFile .NE. ' '  ) THEN        IF ( lambdaSaltFile .NE. ' '  ) THEN
110         CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',         CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
111       &  lambdaSaltClimRelax, 0, myThid )       &  lambdaSaltClimRelax, 0, myThid )
112        ENDIF        ENDIF
113  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
# Line 149  C Line 115  C
115         CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )         CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
116         IF ( surfQFile .NE. ' '  ) THEN         IF ( surfQFile .NE. ' '  ) THEN
117  C-     Qnet is now (after c54) the net Heat Flux (including SW)  C-     Qnet is now (after c54) the net Heat Flux (including SW)
118          DO bj = 1,nSy          DO bj = myByLo(myThid), myByHi(myThid)
119           DO bi = 1,nSx           DO bi = myBxLo(myThid), myBxHi(myThid)
120            DO j=1-OLy,sNy+OLy            DO j=1-OLy,sNy+OLy
121             DO i=1-OLx,sNx+OLx             DO i=1-OLx,sNx+OLx
122              Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)              Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
# Line 163  C-     Qnet is now (after c54) the net H Line 129  C-     Qnet is now (after c54) the net H
129  #endif  #endif
130  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
131        IF ( pLoadFile .NE. ' '  ) THEN        IF ( pLoadFile .NE. ' '  ) THEN
132         CALL READ_FLD_XY_RS( pLoadFile, ' ', pload, 0, myThid )         CALL READ_FLD_XY_RS( pLoadFile, ' ', pLoad, 0, myThid )
133        ENDIF        ENDIF
134  #endif  #endif
135        _END_MASTER(myThid)  #ifdef ALLOW_ADDFLUID
136  C        IF ( addMassFile .NE. ' ' ) THEN
137        _EXCH_XY_R4(fu   , myThid )         CALL READ_FLD_XYZ_RL( addMassFile, ' ', addMass, 0, myThid )
138        _EXCH_XY_R4(fv   , myThid )         CALL EXCH_XYZ_RL( addMass, myThid )
139        _EXCH_XY_R4(Qnet , myThid )        ENDIF
140        _EXCH_XY_R4(EmPmR, myThid )  #endif /* ALLOW_ADDFLUID */
141        _EXCH_XY_R4( saltFlux, myThid )  #ifdef ALLOW_GEOTHERMAL_FLUX
142        _EXCH_XY_R4(SST  , myThid )        IF ( geothermalFile .NE. ' ' ) THEN
143        _EXCH_XY_R4(SSS  , myThid )         CALL READ_FLD_XY_RS( geothermalFile, ' ',
144        _EXCH_XY_R4(lambdaThetaClimRelax , myThid )       &  geothermalFlux, 0, myThid )
145        _EXCH_XY_R4(lambdaSaltClimRelax , myThid )         CALL EXCH_XY_RS( geothermalFlux, myThid )
146    # ifdef ALLOW_MONITOR
147           CALL MON_PRINTSTATS_RS(
148         &  1,geothermalFlux,'geothermalFlux',myThid)
149    # endif
150          ENDIF
151    #endif /* ALLOW_GEOTHERMAL_FLUX */
152    
153          CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
154          CALL EXCH_XY_RS( Qnet , myThid )
155          CALL EXCH_XY_RS( EmPmR, myThid )
156          CALL EXCH_XY_RS( saltFlux, myThid )
157          CALL EXCH_XY_RS( SST  , myThid )
158          CALL EXCH_XY_RS( SSS  , myThid )
159          CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
160          CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
161  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
162        _EXCH_XY_R4(Qsw  , myThid )        CALL EXCH_XY_RS(Qsw  , myThid )
163  #endif  #endif
164  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
165        _EXCH_XY_R4(pload  , myThid )        CALL EXCH_XY_RS(pLoad  , myThid )
166  C     CALL PLOT_FIELD_XYRS( pload, 'S/R INI_FORCING pload',1,myThid)  C     CALL PLOT_FIELD_XYRS( pLoad, 'S/R INI_FORCING pLoad',1,myThid)
167  #endif  #endif
   
168  C     CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)  C     CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
169  C     CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)  C     CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)
170    
171    #ifdef ATMOSPHERIC_LOADING
172          IF ( pLoadFile .NE. ' ' .AND. usingPCoords ) THEN
173    C-- This is a hack used to read phi0surf from a file (pLoadFile)
174    C          instead of computing it from bathymetry & density ref. profile.
175    C-  Ocean: The true atmospheric P-loading is not yet implemented for P-coord
176    C          (requires time varying dP(Nr) like dP(k-bottom) with NonLin FS).
177    C-  Atmos: sometime usefull to overwrite phi0surf with fixed-in-time field
178    C          read from file (and anyway, pressure loading is meaningless here)
179            DO bj = myByLo(myThid), myByHi(myThid)
180             DO bi = myBxLo(myThid), myBxHi(myThid)
181              DO j=1-OLy,sNy+OLy
182               DO i=1-OLx,sNx+OLx
183                 phi0surf(i,j,bi,bj) = pLoad(i,j,bi,bj)
184               ENDDO
185              ENDDO
186             ENDDO
187            ENDDO
188          ENDIF
189    #endif /* ATMOSPHERIC_LOADING */
190    
191        RETURN        RETURN
192        END        END
Legend:
Removed from v.1.39  
changed lines
  Added in v.1.54
  ViewVC Help
Powered by ViewVC 1.1.22