/[MITgcm]/MITgcm/pkg/aim/aim_external_fields_load.F
ViewVC logotype

Diff of /MITgcm/pkg/aim/aim_external_fields_load.F

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

revision 1.1 by cnh, Tue May 29 19:28:53 2001 UTC revision 1.4 by jmc, Fri Sep 27 20:05:11 2002 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "AIM_OPTIONS.h"
5    
6  CStartOfInterface  CStartOfInterface
7        SUBROUTINE AIM_EXTERNAL_FIELDS_LOAD(        SUBROUTINE AIM_EXTERNAL_FIELDS_LOAD(
# Line 26  C     === Global variables === Line 26  C     === Global variables ===
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29    #include "GRID.h"
30  #include "AIM_FFIELDS.h"  #include "AIM_FFIELDS.h"
31    
32  C     === Routine arguments ===  C     === Routine arguments ===
# Line 43  C     === Functions === Line 44  C     === Functions ===
44    
45  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
46  C     === Local variables ===  C     === Local variables ===
47  C     I, J  - Loop counters  C     bi,bj, i,j  - Loop counters
48  C     tYear - Fraction within year of myTime  C     tYear       - Fraction within year of myTime
49  C     mnthIndex     - Current time in whole months  C     mnthIndex   - Current time in whole months
50  C     prevMnthIndex  C     prevMnthIndex
51  C     fNam          - Strings used in constructing file names  C     fNam        - Strings used in constructing file names
52  C     mnthNam  C     mnthNam
53        INTEGER I, J  C     pfact       - used to convert Pot.Temp. to in-situ Temp.
54        REAL tYear        INTEGER bi,bj, i, j
55          _RL pfact
56          _RL tYear
57        INTEGER mnthIndex        INTEGER mnthIndex
58        INTEGER prevMnthIndex        INTEGER prevMnthIndex
59        DATA    prevMnthIndex / 0 /        DATA    prevMnthIndex / 0 /
60        SAVE    prevMnthIndex        SAVE    prevMnthIndex
61        CHARACTER*16 fNam        CHARACTER*17 fNam
62        CHARACTER*3 mnthNam(12)        CHARACTER*3 mnthNam(12)
63        DATA mnthNam /        DATA mnthNam /
64       & 'jan', 'feb', 'mar', 'apr', 'may', 'jun',       & 'jan', 'feb', 'mar', 'apr', 'may', 'jun',
# Line 80  C       Calculate offset into a year Line 83  C       Calculate offset into a year
83  C        New month so load in data  C        New month so load in data
84           prevMnthIndex = mnthIndex           prevMnthIndex = mnthIndex
85  C        o Albedo ( convert % to fraction )  C        o Albedo ( convert % to fraction )
86           WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.sun.b'           WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.ft.bin'
87           OPEN(1,FILE=fNam(1:14),STATUS='old',FORM='unformatted')    c        WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.sun.b'
88           READ(1) aim_albedo           CALL MDSREADFIELD(fNam(1:15),readBinaryPrec,'RS',1,
89           CLOSE(1)       O    aim_albedo,  
90           DO J=1,aim_nyIo       I    1,myThid)
           DO I=1,aim_nxIo  
 C          aim_albedo(I,J) = aim_albedo(I,J)/100.  
           ENDDO  
          ENDDO  
91    
92  C        o Surface temperature ( in kelvin )  C        o Surface temperature ( in kelvin )
93           WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.sun.b'           WRITE(fNam,'(A,A,A)' ) 'stheta.',mnthNam(mnthIndex),'.ft.bin'
94           OPEN(1,FILE=fNam(1:15),STATUS='old',FORM='unformatted')  c        WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.ft.bin'
95           READ(1) aim_surfTemp  c        WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.sun.b'
96           CLOSE(1)           CALL MDSREADFIELD(fNam(1:17),readBinaryPrec,'RS',1,
97         O    aim_surftemp,  
98  C        o Soil moisture ( convert to 20cm bucket fraction )       I    1,myThid)
99           WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.sun.b'  
100           OPEN(1,FILE=fNam(1:16),STATUS='old',FORM='unformatted')  C        o Soil moisture
101           READ(1) aim_soilMoisture           WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.ft.bin'
102           CLOSE(1)  c        WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.sun.b'
103           DO J=1,aim_nyIo           CALL MDSREADFIELD(fNam(1:17),readBinaryPrec,'RS',1,
104            DO I=1,aim_nxIo       O    aim_soilMoisture,  
105  C          aim_soilMoisture(I,J) = aim_soilMoisture(I,J)/20.       I    1,myThid)
106    
107    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
108    
109    C--  Converts fields for direct use in Atmos. Physics routine.
110    C     better here rather than in "aim_do_atmos" since:
111    C     a) change together conversion factor and input file name.
112    C     b) conversion applied only 1 time / month ;
113    C     c) easy to check here (variable in common).
114    
115             DO bj=1,nSy
116              DO bi=1,nSx
117    
118    C-  Converts surface albedo : input data is in % 0-100
119    C     and Francos package needs a fraction between 0-1
120               DO j=1,sNy
121                DO i=1,sNx
122                 aim_albedo(I,J,bi,bj) = aim_albedo(I,J,bi,bj)/100.
123                ENDDO
124               ENDDO
125    
126    C-  Converts soil moisture (case input is in cm in bucket of depth 20cm.)
127    c          DO j=1,sNy
128    c           DO i=1,sNx
129    c            aim_soilMoisture(I,J,bi,bj) = aim_soilMoisture(I,J,bi,bj)
130    c    &                                   /20.
131    c           ENDDO
132    c          ENDDO
133              
134    C-  Converts surface potential temp. to in-situ temperature :
135               DO j=1,sNy
136                DO i=1,sNx
137                 pfact = (Ro_surf(i,j,bi,bj)/atm_po)**atm_kappa
138                 aim_surftemp(i,j,bi,bj) = aim_surftemp(i,j,bi,bj)
139         &                               * pfact
140                ENDDO
141               ENDDO
142    
143    C-- end bi,bj loops
144            ENDDO            ENDDO
145           ENDDO           ENDDO
146    
147             IF (FirstCall)
148         &     CALL WRITE_FLD_XY_RL('aim_Tsurf',' ',aim_surftemp,0,myThid)    
149    
150    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
151    
152          ENDIF          ENDIF
153    
154          FirstCall = .FALSE.          FirstCall = .FALSE.
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22