model/src/ini_forcing.F

C $Header: /u/gcmpack/MITgcm/model/src/ini_forcing.F,v 1.42 2006/10/26 00:32:07 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
#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

      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.43	C $Header: /u/gcmpack/MITgcm/model/src/ini_forcing.F,v 1.42 2006/10/26 00:32:07 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	mlosch	1.23	#ifdef ATMOSPHERIC_LOADING
55			pload (i,j,bi,bj) = 0. _d 0
56	jmc	1.33	sIceLoad (i,j,bi,bj) = 0. _d 0
57	mlosch	1.23	#endif
58	jmc	1.35	surfaceForcingU(i,j,bi,bj) = 0. _d 0
59			surfaceForcingV(i,j,bi,bj) = 0. _d 0
60			surfaceForcingT(i,j,bi,bj) = 0. _d 0
61			surfaceForcingS(i,j,bi,bj) = 0. _d 0
62			surfaceForcingTice(i,j,bi,bj) = 0. _d 0
63	edhill	1.30	#ifndef ALLOW_EXF
64	heimbach	1.24	taux0 (i,j,bi,bj) = 0. _d 0
65			taux1 (i,j,bi,bj) = 0. _d 0
66			tauy0 (i,j,bi,bj) = 0. _d 0
67			tauy1 (i,j,bi,bj) = 0. _d 0
68			Qnet0 (i,j,bi,bj) = 0. _d 0
69			Qnet1 (i,j,bi,bj) = 0. _d 0
70			EmPmR0 (i,j,bi,bj) = 0. _d 0
71			EmPmR1 (i,j,bi,bj) = 0. _d 0
72	jmc	1.37	saltFlux0 (i,j,bi,bj) = 0. _d 0
73			saltFlux1 (i,j,bi,bj) = 0. _d 0
74	heimbach	1.24	SST0 (i,j,bi,bj) = 0. _d 0
75			SST1 (i,j,bi,bj) = 0. _d 0
76			SSS0 (i,j,bi,bj) = 0. _d 0
77			SSS1 (i,j,bi,bj) = 0. _d 0
78	jmc	1.42	#ifdef SHORTWAVE_HEATING
79	heimbach	1.24	Qsw0 (i,j,bi,bj) = 0. _d 0
80			Qsw1 (i,j,bi,bj) = 0. _d 0
81			#endif
82			#ifdef ATMOSPHERIC_LOADING
83			pload0 (i,j,bi,bj) = 0. _d 0
84			pload1 (i,j,bi,bj) = 0. _d 0
85			#endif
86			#endif
87	adcroft	1.10	ENDDO
88			ENDDO
89			ENDDO
90			ENDDO
91	jmc	1.42
92	heimbach	1.38	DO bj = myByLo(myThid), myByHi(myThid)
93			DO bi = myBxLo(myThid), myBxHi(myThid)
94	jmc	1.42	DO j=1-Oly,sNy+Oly
95			DO i=1-Olx,sNx+Olx
96			IF ( doThetaClimRelax .AND.
97			& ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
98			lambdaThetaClimRelax(i,j,bi,bj) = 1. _d 0/tauThetaClimRelax
99	heimbach	1.38	ELSE
100	jmc	1.42	lambdaThetaClimRelax(i,j,bi,bj) = 0. _d 0
101	heimbach	1.38	ENDIF
102			IF ( doSaltClimRelax .AND.
103	jmc	1.42	& ABS(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
104			lambdaSaltClimRelax(i,j,bi,bj) = 1. _d 0/tauSaltClimRelax
105	heimbach	1.38	ELSE
106	jmc	1.42	lambdaSaltClimRelax(i,j,bi,bj) = 0. _d 0
107	heimbach	1.38	ENDIF
108			ENDDO
109			ENDDO
110			ENDDO
111			ENDDO
112	jmc	1.42
113			C- every-one waits before master thread loads from file
114	cnh	1.39	_BARRIER
115	jmc	1.42
116	adcroft	1.16	IF ( zonalWindFile .NE. ' ' ) THEN
117			CALL READ_FLD_XY_RS( zonalWindFile, ' ', fu, 0, myThid )
118			ENDIF
119			IF ( meridWindFile .NE. ' ' ) THEN
120			CALL READ_FLD_XY_RS( meridWindFile, ' ', fv, 0, myThid )
121			ENDIF
122			IF ( surfQFile .NE. ' ' ) THEN
123			CALL READ_FLD_XY_RS( surfQFile, ' ', Qnet, 0, myThid )
124	jmc	1.34	ELSEIF ( surfQnetFile .NE. ' ' ) THEN
125			CALL READ_FLD_XY_RS( surfQnetFile, ' ', Qnet, 0, myThid )
126	adcroft	1.16	ENDIF
127			IF ( EmPmRfile .NE. ' ' ) THEN
128			CALL READ_FLD_XY_RS( EmPmRfile, ' ', EmPmR, 0, myThid )
129			ENDIF
130	jmc	1.37	IF ( saltFluxFile .NE. ' ' ) THEN
131			CALL READ_FLD_XY_RS( saltFluxFile, ' ', saltFlux, 0, myThid )
132			ENDIF
133	adcroft	1.16	IF ( thetaClimFile .NE. ' ' ) THEN
134			CALL READ_FLD_XY_RS( thetaClimFile, ' ', SST, 0, myThid )
135			ENDIF
136			IF ( saltClimFile .NE. ' ' ) THEN
137			CALL READ_FLD_XY_RS( saltClimFile, ' ', SSS, 0, myThid )
138			ENDIF
139	heimbach	1.38	IF ( lambdaThetaFile .NE. ' ' ) THEN
140	jmc	1.42	CALL READ_FLD_XY_RS( lambdaThetaFile, ' ',
141	heimbach	1.38	& lambdaThetaClimRelax, 0, myThid )
142			ENDIF
143			IF ( lambdaSaltFile .NE. ' ' ) THEN
144	jmc	1.42	CALL READ_FLD_XY_RS( lambdaSaltFile, ' ',
145	heimbach	1.38	& lambdaSaltClimRelax, 0, myThid )
146			ENDIF
147	heimbach	1.18	#ifdef SHORTWAVE_HEATING
148			IF ( surfQswFile .NE. ' ' ) THEN
149			CALL READ_FLD_XY_RS( surfQswFile, ' ', Qsw, 0, myThid )
150	jmc	1.34	IF ( surfQFile .NE. ' ' ) THEN
151			C- Qnet is now (after c54) the net Heat Flux (including SW)
152	jmc	1.42	_BARRIER
153			DO bj = myByLo(myThid), myByHi(myThid)
154			DO bi = myBxLo(myThid), myBxHi(myThid)
155	jmc	1.36	DO j=1-OLy,sNy+OLy
156			DO i=1-OLx,sNx+OLx
157	jmc	1.34	Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) + Qsw(i,j,bi,bj)
158	jmc	1.36	ENDDO
159	jmc	1.34	ENDDO
160			ENDDO
161	jmc	1.36	ENDDO
162	jmc	1.34	ENDIF
163	heimbach	1.18	ENDIF
164			#endif
165	mlosch	1.23	#ifdef ATMOSPHERIC_LOADING
166			IF ( pLoadFile .NE. ' ' ) THEN
167			CALL READ_FLD_XY_RS( pLoadFile, ' ', pload, 0, myThid )
168			ENDIF
169			#endif
170	heimbach	1.40
171	jmc	1.43	CALL EXCH_UV_XY_RS( fu,fv, .TRUE., myThid )
172			CALL EXCH_XY_RS( Qnet , myThid )
173			CALL EXCH_XY_RS( EmPmR, myThid )
174			CALL EXCH_XY_RS( saltFlux, myThid )
175			CALL EXCH_XY_RS( SST , myThid )
176			CALL EXCH_XY_RS( SSS , myThid )
177			CALL EXCH_XY_RS( lambdaThetaClimRelax, myThid )
178			CALL EXCH_XY_RS( lambdaSaltClimRelax , myThid )
179	mlosch	1.23	#ifdef SHORTWAVE_HEATING
180	jmc	1.43	CALL EXCH_XY_RS(Qsw , myThid )
181	mlosch	1.23	#endif
182			#ifdef ATMOSPHERIC_LOADING
183	jmc	1.43	CALL EXCH_XY_RS(pload , myThid )
184	mlosch	1.23	C CALL PLOT_FIELD_XYRS( pload, 'S/R INI_FORCING pload',1,myThid)
185			#endif
186	adcroft	1.15	C CALL PLOT_FIELD_XYRS( fu, 'S/R INI_FORCING FU',1,myThid)
187			C CALL PLOT_FIELD_XYRS( fv, 'S/R INI_FORCING FV',1,myThid)
188	cnh	1.1
189			RETURN
190			END