/[MITgcm]/MITgcm/pkg/seaice/seaice_get_forcing.F
ViewVC logotype

Diff of /MITgcm/pkg/seaice/seaice_get_forcing.F

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

revision 1.4 by dimitri, Sat Dec 28 10:11:11 2002 UTC revision 1.5 by dimitri, Tue Feb 18 05:33:55 2003 UTC
# Line 47  C     === Local variables === Line 47  C     === Local variables ===
47        _RL aWghtWind,bWghtWind,aWghtFlux,bWghtFlux,        _RL aWghtWind,bWghtWind,aWghtFlux,bWghtFlux,
48       &     aWghtSSS,bWghtSSS,aWghtSST,bWghtSST       &     aWghtSSS,bWghtSSS,aWghtSST,bWghtSST
49        _RS initValue        _RS initValue
50        _RL year, seconds, YearTime        _RL year, seconds, YearTime, four
51        INTEGER CurrentYear, CurrentYear2        INTEGER CurrentYear, CurrentYear2
52        logical done        logical done
53        CHARACTER*(MAX_LEN_MBUF) fName        CHARACTER*(MAX_LEN_MBUF) fName
54    
55  C--   Compute CurrentYear and YearTime  C--   Compute CurrentYear and YearTime
56          four = 4.0
57        YearTime = myTime        YearTime = myTime
58        done = .false.        done = .false.
59        do year = StartingYear, EndingYear        do year = StartingYear, EndingYear
60           if( .not. done ) then           if( .not. done ) then
61              if( mod(year,4.) .eq. 0. ) then              if( mod(year,four) .eq. 0. ) then
62                 seconds = 366.*24.*60.*60.                 seconds = 366.*24.*60.*60.
63              else              else
64                 seconds = 365.*24.*60.*60.                 seconds = 365.*24.*60.*60.
# Line 105  C--   First call requires that we initia Line 106  C--   First call requires that we initia
106         CALL INIT_ARRAY_RS( aqh0    , initValue, myThid )         CALL INIT_ARRAY_RS( aqh0    , initValue, myThid )
107         CALL INIT_ARRAY_RS( aqh1    , initValue, myThid )         CALL INIT_ARRAY_RS( aqh1    , initValue, myThid )
108         initValue = 300. _d 0         initValue = 300. _d 0
109         CALL INIT_ARRAY_RS( lwflux0 , initValue, myThid )         CALL INIT_ARRAY_RS( lwdown0 , initValue, myThid )
110         CALL INIT_ARRAY_RS( lwflux1 , initValue, myThid )         CALL INIT_ARRAY_RS( lwdown1 , initValue, myThid )
111         initValue = 200. _d 0         initValue = 200. _d 0
112         CALL INIT_ARRAY_RS( swflux0 , initValue, myThid )         CALL INIT_ARRAY_RS( swdown0 , initValue, myThid )
113         CALL INIT_ARRAY_RS( swflux1 , initValue, myThid )         CALL INIT_ARRAY_RS( swdown1 , initValue, myThid )
114         initValue = ZERO         initValue = ZERO
115         CALL INIT_ARRAY_RS( precip0 , initValue, myThid )         CALL INIT_ARRAY_RS( precip0 , initValue, myThid )
116         CALL INIT_ARRAY_RS( precip1 , initValue, myThid )         CALL INIT_ARRAY_RS( precip1 , initValue, myThid )
# Line 160  C--   First call requires that we initia Line 161  C--   First call requires that we initia
161          CALL READ_REC_XY_RS( fName,aqh0,iRec  ,myIter,myThid )          CALL READ_REC_XY_RS( fName,aqh0,iRec  ,myIter,myThid )
162          CALL READ_REC_XY_RS( fName,aqh1,iRec+1,myIter,myThid )          CALL READ_REC_XY_RS( fName,aqh1,iRec+1,myIter,myThid )
163         ENDIF         ENDIF
164         IF ( lwfluxFile .NE. ' ' ) THEN         IF ( lwdownFile .NE. ' ' ) THEN
165          iEnd = ILNBLNK( lwfluxFile ) - 4          iEnd = ILNBLNK( lwdownFile ) - 4
166          WRITE(fName,'(A,I4.4)') lwfluxFile(1:iEnd), CurrentYear          WRITE(fName,'(A,I4.4)') lwdownFile(1:iEnd), CurrentYear
167          CALL READ_REC_XY_RS( fName,lwflux0,iRec  ,myIter,myThid )          CALL READ_REC_XY_RS( fName,lwdown0,iRec  ,myIter,myThid )
168          CALL READ_REC_XY_RS( fName,lwflux1,iRec+1,myIter,myThid )          CALL READ_REC_XY_RS( fName,lwdown1,iRec+1,myIter,myThid )
169         ENDIF         ENDIF
170         IF ( swfluxFile .NE. ' ' ) THEN         IF ( swdownFile .NE. ' ' ) THEN
171          iEnd = ILNBLNK( swfluxFile ) - 4          iEnd = ILNBLNK( swdownFile ) - 4
172          WRITE(fName,'(A,I4.4)') swfluxFile(1:iEnd), CurrentYear          WRITE(fName,'(A,I4.4)') swdownFile(1:iEnd), CurrentYear
173          CALL READ_REC_XY_RS( fName,swflux0,iRec  ,myIter,myThid )          CALL READ_REC_XY_RS( fName,swdown0,iRec  ,myIter,myThid )
174          CALL READ_REC_XY_RS( fName,swflux1,iRec+1,myIter,myThid )          CALL READ_REC_XY_RS( fName,swdown1,iRec+1,myIter,myThid )
175         ENDIF         ENDIF
176         IF ( precipFile .NE. ' ' ) THEN         IF ( precipFile .NE. ' ' ) THEN
177          iEnd = ILNBLNK( precipFile ) - 4          iEnd = ILNBLNK( precipFile ) - 4
# Line 215  C--   First call requires that we initia Line 216  C--   First call requires that we initia
216         _EXCH_XY_R4( atemp1,  myThid )         _EXCH_XY_R4( atemp1,  myThid )
217         _EXCH_XY_R4( aqh0,    myThid )         _EXCH_XY_R4( aqh0,    myThid )
218         _EXCH_XY_R4( aqh1,    myThid )         _EXCH_XY_R4( aqh1,    myThid )
219         _EXCH_XY_R4( lwflux0, myThid )         _EXCH_XY_R4( lwdown0, myThid )
220         _EXCH_XY_R4( lwflux1, myThid )         _EXCH_XY_R4( lwdown1, myThid )
221         _EXCH_XY_R4( swflux0, myThid )         _EXCH_XY_R4( swdown0, myThid )
222         _EXCH_XY_R4( swflux1, myThid )         _EXCH_XY_R4( swdown1, myThid )
223         _EXCH_XY_R4( precip0, myThid )         _EXCH_XY_R4( precip0, myThid )
224         _EXCH_XY_R4( precip1, myThid )         _EXCH_XY_R4( precip1, myThid )
225         _EXCH_XY_R4( evap0,   myThid )         _EXCH_XY_R4( evap0,   myThid )
# Line 298  C--   Now calculate whether if it is tim Line 299  C--   Now calculate whether if it is tim
299           CALL READ_REC_XY_RS( fName,aqh1,iRec,myIter,myThid )           CALL READ_REC_XY_RS( fName,aqh1,iRec,myIter,myThid )
300          ENDIF          ENDIF
301         ENDIF         ENDIF
302         IF ( lwfluxFile .NE. ' ' ) THEN         IF ( lwdownFile .NE. ' ' ) THEN
303          iEnd = ILNBLNK( lwfluxFile ) - 4          iEnd = ILNBLNK( lwdownFile ) - 4
304          WRITE(fName,'(A,I4.4)') lwfluxFile(1:iEnd), CurrentYear          WRITE(fName,'(A,I4.4)') lwdownFile(1:iEnd), CurrentYear
305          IF (flux0_is_first) THEN          IF (flux0_is_first) THEN
306           CALL READ_REC_XY_RS( fName,lwflux0,iRec,myIter,myThid )           CALL READ_REC_XY_RS( fName,lwdown0,iRec,myIter,myThid )
307          ELSE          ELSE
308           CALL READ_REC_XY_RS( fName,lwflux1,iRec,myIter,myThid )           CALL READ_REC_XY_RS( fName,lwdown1,iRec,myIter,myThid )
309          ENDIF          ENDIF
310         ENDIF         ENDIF
311         IF ( swfluxFile .NE. ' ' ) THEN         IF ( swdownFile .NE. ' ' ) THEN
312          iEnd = ILNBLNK( swfluxFile ) - 4          iEnd = ILNBLNK( swdownFile ) - 4
313          WRITE(fName,'(A,I4.4)') swfluxFile(1:iEnd), CurrentYear          WRITE(fName,'(A,I4.4)') swdownFile(1:iEnd), CurrentYear
314          IF (flux0_is_first) THEN          IF (flux0_is_first) THEN
315           CALL READ_REC_XY_RS( fName,swflux0,iRec,myIter,myThid )           CALL READ_REC_XY_RS( fName,swdown0,iRec,myIter,myThid )
316          ELSE          ELSE
317           CALL READ_REC_XY_RS( fName,swflux1,iRec,myIter,myThid )           CALL READ_REC_XY_RS( fName,swdown1,iRec,myIter,myThid )
318          ENDIF          ENDIF
319         ENDIF         ENDIF
320         IF ( precipFile .NE. ' ' ) THEN         IF ( precipFile .NE. ' ' ) THEN
# Line 347  C--   Now calculate whether if it is tim Line 348  C--   Now calculate whether if it is tim
348         IF (flux0_is_first) THEN         IF (flux0_is_first) THEN
349          _EXCH_XY_R4(atemp0,  myThid )          _EXCH_XY_R4(atemp0,  myThid )
350          _EXCH_XY_R4(aqh0,    myThid )          _EXCH_XY_R4(aqh0,    myThid )
351          _EXCH_XY_R4(lwflux0, myThid )          _EXCH_XY_R4(lwdown0, myThid )
352          _EXCH_XY_R4(swflux0, myThid )          _EXCH_XY_R4(swdown0, myThid )
353          _EXCH_XY_R4(precip0, myThid )          _EXCH_XY_R4(precip0, myThid )
354          _EXCH_XY_R4(evap0,   myThid )          _EXCH_XY_R4(evap0,   myThid )
355          _EXCH_XY_R4(runoff0, myThid )          _EXCH_XY_R4(runoff0, myThid )
# Line 356  C--   Now calculate whether if it is tim Line 357  C--   Now calculate whether if it is tim
357         ELSE         ELSE
358          _EXCH_XY_R4(atemp1,  myThid )          _EXCH_XY_R4(atemp1,  myThid )
359          _EXCH_XY_R4(aqh1,    myThid )          _EXCH_XY_R4(aqh1,    myThid )
360          _EXCH_XY_R4(lwflux1, myThid )          _EXCH_XY_R4(lwdown1, myThid )
361          _EXCH_XY_R4(swflux1, myThid )          _EXCH_XY_R4(swdown1, myThid )
362          _EXCH_XY_R4(precip1, myThid )          _EXCH_XY_R4(precip1, myThid )
363          _EXCH_XY_R4(evap1,   myThid )          _EXCH_XY_R4(evap1,   myThid )
364          _EXCH_XY_R4(runoff1, myThid )          _EXCH_XY_R4(runoff1, myThid )
# Line 452  C--   Time interpolation of flux forcing Line 453  C--   Time interpolation of flux forcing
453       &                        aWghtFlux *  atemp1(i,j,bi,bj)       &                        aWghtFlux *  atemp1(i,j,bi,bj)
454            aqh(i,j,bi,bj)    = bWghtFlux *    aqh0(i,j,bi,bj) +            aqh(i,j,bi,bj)    = bWghtFlux *    aqh0(i,j,bi,bj) +
455       &                        aWghtFlux *    aqh1(i,j,bi,bj)       &                        aWghtFlux *    aqh1(i,j,bi,bj)
456            lwflux(i,j,bi,bj) = bWghtFlux * lwflux0(i,j,bi,bj) +            lwdown(i,j,bi,bj) = bWghtFlux * lwdown0(i,j,bi,bj) +
457       &                        aWghtFlux * lwflux1(i,j,bi,bj)       &                        aWghtFlux * lwdown1(i,j,bi,bj)
458            swflux(i,j,bi,bj) = bWghtFlux * swflux0(i,j,bi,bj) +            swdown(i,j,bi,bj) = bWghtFlux * swdown0(i,j,bi,bj) +
459       &                        aWghtFlux * swflux1(i,j,bi,bj)       &                        aWghtFlux * swdown1(i,j,bi,bj)
460            precip(i,j,bi,bj) = bWghtFlux * precip0(i,j,bi,bj) +            precip(i,j,bi,bj) = bWghtFlux * precip0(i,j,bi,bj) +
461       &                        aWghtFlux *   precip1(i,j,bi,bj)       &                        aWghtFlux *   precip1(i,j,bi,bj)
462            evap(i,j,bi,bj)   = bWghtFlux *   evap0(i,j,bi,bj) +            evap(i,j,bi,bj)   = bWghtFlux *   evap0(i,j,bi,bj) +
# Line 475  C--   Time interpolation of flux forcing Line 476  C--   Time interpolation of flux forcing
476       &                        bWghtFlux *  atemp1(i,j,bi,bj)       &                        bWghtFlux *  atemp1(i,j,bi,bj)
477            aqh(i,j,bi,bj)    = aWghtFlux *    aqh0(i,j,bi,bj) +            aqh(i,j,bi,bj)    = aWghtFlux *    aqh0(i,j,bi,bj) +
478       &                        bWghtFlux *    aqh1(i,j,bi,bj)       &                        bWghtFlux *    aqh1(i,j,bi,bj)
479            lwflux(i,j,bi,bj) = aWghtFlux * lwflux0(i,j,bi,bj) +            lwdown(i,j,bi,bj) = aWghtFlux * lwdown0(i,j,bi,bj) +
480       &                        bWghtFlux * lwflux1(i,j,bi,bj)       &                        bWghtFlux * lwdown1(i,j,bi,bj)
481            swflux(i,j,bi,bj) = aWghtFlux * swflux0(i,j,bi,bj) +            swdown(i,j,bi,bj) = aWghtFlux * swdown0(i,j,bi,bj) +
482       &                        bWghtFlux * swflux1(i,j,bi,bj)       &                        bWghtFlux * swdown1(i,j,bi,bj)
483            precip(i,j,bi,bj) = aWghtFlux * precip0(i,j,bi,bj) +            precip(i,j,bi,bj) = aWghtFlux * precip0(i,j,bi,bj) +
484       &                        bWghtFlux * precip1(i,j,bi,bj)       &                        bWghtFlux * precip1(i,j,bi,bj)
485            evap(i,j,bi,bj)   = aWghtFlux *   evap0(i,j,bi,bj) +            evap(i,j,bi,bj)   = aWghtFlux *   evap0(i,j,bi,bj) +
# Line 541  C--   Time interpolation of SST forcing Line 542  C--   Time interpolation of SST forcing
542         ENDDO         ENDDO
543        ENDIF        ENDIF
544    
545  #endif SEAICE_EXTERNAL_FORCING  #endif /* SEAICE_EXTERNAL_FORCING */
546  #endif ALLOW_SEAICE  #endif /* ALLOW_SEAICE */
547    
548        RETURN        RETURN
549        END        END
# Line 577  C Line 578  C
578         ENDDO         ENDDO
579        ENDDO        ENDDO
580    
581  #endif SEAICE_EXTERNAL_FORCING  #endif /* SEAICE_EXTERNAL_FORCING */
582  #endif ALLOW_SEAICE  #endif /* ALLOW_SEAICE */
583    
584        RETURN        RETURN
585        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22