model/src/ini_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/ini_forcing.F,v 1.43 2007/04/01 19:08:38 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INI_FORCING
C     !INTERFACE:
      SUBROUTINE INI_FORCING( myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE INI_FORCING
C     | o Set model initial forcing fields.
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "FFIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myThid -  Number of this instance of INI_FORCING
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     bi,bj  - Loop counters
C     i, j
      INTEGER bi, bj
      INTEGER  i, j
CEOP

C-    Initialise all arrays in common blocks
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO j=1-OLy,sNy+OLy
         DO i=1-OLx,sNx+OLx
          fu              (i,j,bi,bj) = 0. _d 0
          fv              (i,j,bi,bj) = 0. _d 0
          Qnet            (i,j,bi,bj) = 0. _d 0
          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
          pLoad           (i,j,bi,bj) = 0. _d 0
          sIceLoad        (i,j,bi,bj) = 0. _d 0
          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 EXCLUDE_FFIELDS_LOAD
          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 /* EXCLUDE_FFIELDS_LOAD */
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      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. _d 0/tauThetaClimRelax
          ELSE
           lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
          ENDIF
          IF ( doSaltClimRelax .AND.
     &         ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
           lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
          ELSE
           lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
          ENDIF
         ENDDO
        ENDDO
       ENDDO
      ENDDO

C-    every-one waits before master thread loads from file
      _BARRIER

      IF ( zonalWindFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
      ENDIF
      IF ( meridWindFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( meridWindFile, ' ', fv, 0, myThid )
      ENDIF
      IF ( surfQFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( surfQFile, ' ', Qnet, 0, myThid )
      ELSEIF ( surfQnetFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( surfQnetFile, ' ', Qnet, 0, myThid )
      ENDIF
      IF ( EmPmRfile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
      ENDIF
      IF ( saltFluxFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
      ENDIF
      IF ( thetaClimFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( thetaClimFile, ' ', SST, 0, myThid )
      ENDIF
      IF ( saltClimFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
      ENDIF
      IF ( lambdaThetaFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
     &  lambdaThetaClimRelax, 0, myThid )
      ENDIF
      IF ( lambdaSaltFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
     &  lambdaSaltClimRelax, 0, myThid )
      ENDIF
#ifdef SHORTWAVE_HEATING
      IF ( surfQswFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
       IF ( surfQFile .NE. ' '  ) THEN
C-     Qnet is now (after c54) the net Heat Flux (including SW)
        _BARRIER
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
            Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDIF
      ENDIF
#endif
#ifdef ATMOSPHERIC_LOADING
      IF ( pLoadFile .NE. ' '  ) THEN
       CALL READ_FLD_XY_RS( pLoadFile, ' ', pLoad, 0, myThid )
      ENDIF
#endif

      CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
      CALL EXCH_XY_RS( Qnet , myThid )
      CALL EXCH_XY_RS( EmPmR, myThid )
      CALL EXCH_XY_RS( saltFlux, myThid )
      CALL EXCH_XY_RS( SST  , myThid )
      CALL EXCH_XY_RS( SSS  , myThid )
      CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
      CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
#ifdef SHORTWAVE_HEATING
      CALL EXCH_XY_RS(Qsw  , myThid )
#endif
#ifdef ATMOSPHERIC_LOADING
      CALL EXCH_XY_RS(pLoad  , myThid )
C     CALL PLOT_FIELD_XYRS( pLoad, 'S/R INI_FORCING pLoad',1,myThid)
#endif
C     CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
C     CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)

      RETURN
      END
1	jmc	1.44	C $Header: /u/gcmpack/MITgcm/model/src/ini_forcing.F,v 1.43 2007/04/01 19:08:38 jmc Exp $
2	cnh	1.22	C $Name: $
3	cnh	1.1
4	edhill	1.26	#include "PACKAGES_CONFIG.h"
5	cnh	1.12	#include "CPP_OPTIONS.h"
6	cnh	1.1
7	cnh	1.22	CBOP
8			C !ROUTINE: INI_FORCING
9			C !INTERFACE:
10	cnh	1.1	SUBROUTINE INI_FORCING( myThid )
11	cnh	1.22
12			C !DESCRIPTION: \bv
13			C ==========================================================
14	jmc	1.42	C \| SUBROUTINE INI_FORCING
15			C \| o Set model initial forcing fields.
16	cnh	1.22	C ==========================================================
17			C \ev
18
19			C !USES:
20	adcroft	1.14	IMPLICIT NONE
21	cnh	1.1	C === Global variables ===
22			#include "SIZE.h"
23			#include "EEPARAMS.h"
24			#include "PARAMS.h"
25			#include "GRID.h"
26			#include "FFIELDS.h"
27
28	cnh	1.22	C !INPUT/OUTPUT PARAMETERS:
29	cnh	1.1	C == Routine arguments ==
30			C myThid - Number of this instance of INI_FORCING
31			INTEGER myThid
32
33	cnh	1.22	C !LOCAL VARIABLES:
34	cnh	1.1	C == Local variables ==
35			C bi,bj - Loop counters
36	jmc	1.42	C i, j
37	cnh	1.1	INTEGER bi, bj
38	jmc	1.42	INTEGER i, j
39	cnh	1.22	CEOP
40	cnh	1.1
41	jmc	1.42	C- Initialise all arrays in common blocks
42	adcroft	1.10	DO bj = myByLo(myThid), myByHi(myThid)
43			DO bi = myBxLo(myThid), myBxHi(myThid)
44			DO j=1-OLy,sNy+OLy
45			DO i=1-OLx,sNx+OLx
46	heimbach	1.18	fu (i,j,bi,bj) = 0. _d 0
47			fv (i,j,bi,bj) = 0. _d 0
48			Qnet (i,j,bi,bj) = 0. _d 0
49			EmPmR (i,j,bi,bj) = 0. _d 0
50	jmc	1.27	saltFlux (i,j,bi,bj) = 0. _d 0
51	heimbach	1.18	SST (i,j,bi,bj) = 0. _d 0
52			SSS (i,j,bi,bj) = 0. _d 0
53			Qsw (i,j,bi,bj) = 0. _d 0
54	jmc	1.44	pLoad (i,j,bi,bj) = 0. _d 0
55	jmc	1.33	sIceLoad (i,j,bi,bj) = 0. _d 0
56	jmc	1.35	surfaceForcingU(i,j,bi,bj) = 0. _d 0
57			surfaceForcingV(i,j,bi,bj) = 0. _d 0
58			surfaceForcingT(i,j,bi,bj) = 0. _d 0
59			surfaceForcingS(i,j,bi,bj) = 0. _d 0
60			surfaceForcingTice(i,j,bi,bj) = 0. _d 0
61	jmc	1.44	#ifndef EXCLUDE_FFIELDS_LOAD
62	heimbach	1.24	taux0 (i,j,bi,bj) = 0. _d 0
63			taux1 (i,j,bi,bj) = 0. _d 0
64			tauy0 (i,j,bi,bj) = 0. _d 0
65			tauy1 (i,j,bi,bj) = 0. _d 0
66			Qnet0 (i,j,bi,bj) = 0. _d 0
67			Qnet1 (i,j,bi,bj) = 0. _d 0
68			EmPmR0 (i,j,bi,bj) = 0. _d 0
69			EmPmR1 (i,j,bi,bj) = 0. _d 0
70	jmc	1.37	saltFlux0 (i,j,bi,bj) = 0. _d 0
71			saltFlux1 (i,j,bi,bj) = 0. _d 0
72	heimbach	1.24	SST0 (i,j,bi,bj) = 0. _d 0
73			SST1 (i,j,bi,bj) = 0. _d 0
74			SSS0 (i,j,bi,bj) = 0. _d 0
75			SSS1 (i,j,bi,bj) = 0. _d 0
76	jmc	1.42	#ifdef SHORTWAVE_HEATING
77	heimbach	1.24	Qsw0 (i,j,bi,bj) = 0. _d 0
78			Qsw1 (i,j,bi,bj) = 0. _d 0
79			#endif
80			#ifdef ATMOSPHERIC_LOADING
81	jmc	1.44	pLoad0 (i,j,bi,bj) = 0. _d 0
82			pLoad1 (i,j,bi,bj) = 0. _d 0
83	heimbach	1.24	#endif
84	jmc	1.44	#endif /* EXCLUDE_FFIELDS_LOAD */
85	adcroft	1.10	ENDDO
86			ENDDO
87			ENDDO
88			ENDDO
89	jmc	1.42
90	heimbach	1.38	DO bj = myByLo(myThid), myByHi(myThid)
91			DO bi = myBxLo(myThid), myBxHi(myThid)
92	jmc	1.42	DO j=1-Oly,sNy+Oly
93			DO i=1-Olx,sNx+Olx
94			IF ( doThetaClimRelax .AND.
95			& ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
96			lambdaThetaClimRelax(i,j,bi,bj) = 1. _d 0/tauThetaClimRelax
97	heimbach	1.38	ELSE
98	jmc	1.42	lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
99	heimbach	1.38	ENDIF
100			IF ( doSaltClimRelax .AND.
101	jmc	1.42	& ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
102			lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
103	heimbach	1.38	ELSE
104	jmc	1.42	lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
105	heimbach	1.38	ENDIF
106			ENDDO
107			ENDDO
108			ENDDO
109			ENDDO
110	jmc	1.42
111			C- every-one waits before master thread loads from file
112	cnh	1.39	_BARRIER
113	jmc	1.42
114	adcroft	1.16	IF ( zonalWindFile .NE. ' ' ) THEN
115			CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
116			ENDIF
117			IF ( meridWindFile .NE. ' ' ) THEN
118			CALL READ_FLD_XY_RS( meridWindFile, ' ', fv, 0, myThid )
119			ENDIF
120			IF ( surfQFile .NE. ' ' ) THEN
121			CALL READ_FLD_XY_RS( surfQFile, ' ', Qnet, 0, myThid )
122	jmc	1.34	ELSEIF ( surfQnetFile .NE. ' ' ) THEN
123			CALL READ_FLD_XY_RS( surfQnetFile, ' ', Qnet, 0, myThid )
124	adcroft	1.16	ENDIF
125			IF ( EmPmRfile .NE. ' ' ) THEN
126			CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
127			ENDIF
128	jmc	1.37	IF ( saltFluxFile .NE. ' ' ) THEN
129			CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
130			ENDIF
131	adcroft	1.16	IF ( thetaClimFile .NE. ' ' ) THEN
132			CALL READ_FLD_XY_RS( thetaClimFile, ' ', SST, 0, myThid )
133			ENDIF
134			IF ( saltClimFile .NE. ' ' ) THEN
135			CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
136			ENDIF
137	heimbach	1.38	IF ( lambdaThetaFile .NE. ' ' ) THEN
138	jmc	1.42	CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
139	heimbach	1.38	& lambdaThetaClimRelax, 0, myThid )
140			ENDIF
141			IF ( lambdaSaltFile .NE. ' ' ) THEN
142	jmc	1.42	CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
143	heimbach	1.38	& lambdaSaltClimRelax, 0, myThid )
144			ENDIF
145	heimbach	1.18	#ifdef SHORTWAVE_HEATING
146			IF ( surfQswFile .NE. ' ' ) THEN
147			CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
148	jmc	1.34	IF ( surfQFile .NE. ' ' ) THEN
149			C- Qnet is now (after c54) the net Heat Flux (including SW)
150	jmc	1.42	_BARRIER
151			DO bj = myByLo(myThid), myByHi(myThid)
152			DO bi = myBxLo(myThid), myBxHi(myThid)
153	jmc	1.36	DO j=1-OLy,sNy+OLy
154			DO i=1-OLx,sNx+OLx
155	jmc	1.34	Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
156	jmc	1.36	ENDDO
157	jmc	1.34	ENDDO
158			ENDDO
159	jmc	1.36	ENDDO
160	jmc	1.34	ENDIF
161	heimbach	1.18	ENDIF
162			#endif
163	mlosch	1.23	#ifdef ATMOSPHERIC_LOADING
164			IF ( pLoadFile .NE. ' ' ) THEN
165	jmc	1.44	CALL READ_FLD_XY_RS( pLoadFile, ' ', pLoad, 0, myThid )
166	mlosch	1.23	ENDIF
167			#endif
168	heimbach	1.40
169	jmc	1.43	CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
170			CALL EXCH_XY_RS( Qnet , myThid )
171			CALL EXCH_XY_RS( EmPmR, myThid )
172			CALL EXCH_XY_RS( saltFlux, myThid )
173			CALL EXCH_XY_RS( SST , myThid )
174			CALL EXCH_XY_RS( SSS , myThid )
175			CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
176			CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
177	mlosch	1.23	#ifdef SHORTWAVE_HEATING
178	jmc	1.43	CALL EXCH_XY_RS(Qsw , myThid )
179	mlosch	1.23	#endif
180			#ifdef ATMOSPHERIC_LOADING
181	jmc	1.44	CALL EXCH_XY_RS(pLoad , myThid )
182			C CALL PLOT_FIELD_XYRS( pLoad, 'S/R INI_FORCING pLoad',1,myThid)
183	mlosch	1.23	#endif
184	adcroft	1.15	C CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
185			C CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)
186	cnh	1.1
187			RETURN
188			END