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

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

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

Revision 1.4 - (hide annotations) (download)
Fri Sep 27 20:05:11 2002 UTC (21 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint48f_post, checkpoint51k_post, checkpoint47j_post, checkpoint48d_pre, checkpoint51l_post, checkpoint51j_post, branch-exfmods-tag, checkpoint47e_post, checkpoint48i_post, checkpoint47f_post, checkpoint48d_post, checkpoint51o_pre, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint50c_post, checkpoint46i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint47a_post, checkpoint48a_post, checkpoint51f_pre, checkpoint48e_post, checkpoint48h_post, checkpoint50c_pre, branchpoint-genmake2, checkpoint46k_post, branch-netcdf, checkpoint50d_pre, checkpoint51r_post, checkpoint47i_post, checkpoint52b_pre, checkpoint46l_pre, checkpoint46j_pre, checkpoint51i_post, checkpoint47h_post, checkpoint48c_post, checkpoint46l_post, checkpoint51e_post, checkpoint51b_post, checkpoint51l_pre, checkpoint51c_post, checkpoint48, checkpoint49, checkpoint47b_post, checkpoint51o_post, checkpoint48g_post, checkpoint51q_post, checkpoint51, checkpoint50, checkpoint52, checkpoint50d_post, checkpoint51b_pre, checkpoint52a_post, checkpoint47g_post, checkpoint52b_post, checkpoint52c_post, checkpoint46m_post, checkpoint51h_pre, checkpoint50g_post, checkpoint50b_pre, checkpoint51g_post, ecco_c52_e35, checkpoint51f_post, checkpoint48b_post, checkpoint50b_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52a_pre, checkpoint47d_pre, checkpoint51d_post, checkpoint48c_pre, checkpoint51m_post, checkpoint51t_post, checkpoint47, checkpoint50h_post, checkpoint51a_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, checkpoint51i_pre, checkpoint51u_post, checkpoint51s_post
Branch point for: branch-genmake2, branch-nonh, tg2-branch, checkpoint51n_branch, branch-exfmods-curt
Changes since 1.3: +2 -2 lines 
Clean up AIM package (and keep the results unchanged):
a) include CPP_OPTION and use IMPLICT NONE in all routines ;
  declare all the variables _RL ;
b) use _d 0 for all numerical constants in Physics package,
  so that the code works with g77 (and give the right answer)
c) use ifdef ALLOW_AIM everywhere so that the package can be
 compiled without increasing the memory size.
d) clean-up the AIM interface (remove commented lines, unused
  variables ...)
1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/aim/aim_external_fields_load.F,v 1.3 2002/01/08 22:33:10 jmc Exp $
2 cnh 1.1 C $Name: $
3    
4 jmc 1.3 #include "AIM_OPTIONS.h"
5 cnh 1.1
6     CStartOfInterface
7     SUBROUTINE AIM_EXTERNAL_FIELDS_LOAD(
8     I myTime, myIter, myThid )
9     C /==========================================================\
10     C | SUBROUTINE AIM_EXTERNAL_FIELDS_LOAD |
11     C | o Control reading of AIM fields from external source. |
12     C |==========================================================|
13     C | Loads bottom boundary condition datasets for AIM. |
14     C | The routine is called every timetep and periodically |
15     C | loads a set of external fields. |
16     C | Monthly climatology files are read for |
17     C | Albedo |
18     C | Soil moisture |
19     C | Land and sea surface temps. |
20     C | Most of the work is done by the master the thread while |
21     C | the other threads spin. |
22     C \==========================================================/
23     IMPLICIT NONE
24    
25     C === Global variables ===
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29 jmc 1.3 #include "GRID.h"
30 cnh 1.1 #include "AIM_FFIELDS.h"
31    
32     C === Routine arguments ===
33     C myThid - Thread no. that called this routine.
34     C myTime - Simulation time
35     C myIter - Simulation timestep number
36     INTEGER myThid
37     _RL myTime
38     INTEGER myIter
39     CEndOfInterface
40    
41     C === Functions ===
42     LOGICAL DIFFERENT_MULTIPLE
43     EXTERNAL DIFFERENT_MULTIPLE
44    
45     #ifdef ALLOW_AIM
46     C === Local variables ===
47 jmc 1.3 C bi,bj, i,j - Loop counters
48     C tYear - Fraction within year of myTime
49     C mnthIndex - Current time in whole months
50 cnh 1.1 C prevMnthIndex
51 jmc 1.3 C fNam - Strings used in constructing file names
52 cnh 1.1 C mnthNam
53 jmc 1.3 C pfact - used to convert Pot.Temp. to in-situ Temp.
54     INTEGER bi,bj, i, j
55     _RL pfact
56 jmc 1.4 _RL tYear
57 cnh 1.1 INTEGER mnthIndex
58     INTEGER prevMnthIndex
59     DATA prevMnthIndex / 0 /
60     SAVE prevMnthIndex
61 cnh 1.2 CHARACTER*17 fNam
62 cnh 1.1 CHARACTER*3 mnthNam(12)
63     DATA mnthNam /
64     & 'jan', 'feb', 'mar', 'apr', 'may', 'jun',
65     & 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' /
66     SAVE mnthNam
67     LOGICAL firstCall
68     DATA FirstCall /.TRUE./
69     SAVE FirstCall
70    
71     C Prevent loading of new data before everyone has finished with it
72     CALL BAR2(myThid)
73    
74     C Master thread coordinates loading of AIM datasets
75     _BEGIN_MASTER( myThid )
76    
77     C Calculate offset into a year
78     tYear = myTime/(86400.*360.) -
79     & FLOAT(INT(myTime/(86400.*360.)))
80     mnthIndex = INT(tYear*12.)+1
81     IF ( mnthIndex .NE. prevMnthIndex .OR.
82     & FirstCall ) THEN
83     C New month so load in data
84     prevMnthIndex = mnthIndex
85     C o Albedo ( convert % to fraction )
86 jmc 1.3 WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.ft.bin'
87     c WRITE(fNam,'(A,A,A)' ) 'salb.',mnthNam(mnthIndex),'.sun.b'
88 cnh 1.2 CALL MDSREADFIELD(fNam(1:15),readBinaryPrec,'RS',1,
89     O aim_albedo,
90     I 1,myThid)
91 cnh 1.1
92     C o Surface temperature ( in kelvin )
93 jmc 1.3 WRITE(fNam,'(A,A,A)' ) 'stheta.',mnthNam(mnthIndex),'.ft.bin'
94     c WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.ft.bin'
95     c WRITE(fNam,'(A,A,A)' ) 'tsurf.',mnthNam(mnthIndex),'.sun.b'
96     CALL MDSREADFIELD(fNam(1:17),readBinaryPrec,'RS',1,
97 cnh 1.2 O aim_surftemp,
98     I 1,myThid)
99 cnh 1.1
100 jmc 1.3 C o Soil moisture
101     WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.ft.bin'
102     c WRITE(fNam,'(A,A,A)' ) 'smoist.',mnthNam(mnthIndex),'.sun.b'
103 cnh 1.2 CALL MDSREADFIELD(fNam(1:17),readBinaryPrec,'RS',1,
104     O aim_soilMoisture,
105     I 1,myThid)
106 jmc 1.3
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
145     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 cnh 1.1
152     ENDIF
153    
154     FirstCall = .FALSE.
155     _END_MASTER( myThid )
156    
157     C Stop anyone leaving until all data is read
158     CALL BAR2(myThid)
159    
160     #endif /* ALLOW_AIM */
161    
162     RETURN
163     END
  ViewVC Help
Powered by ViewVC 1.1.22