-
Notifications
You must be signed in to change notification settings - Fork 237
/
land_read_pickup.F
112 lines (89 loc) · 3.23 KB
/
land_read_pickup.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#include "LAND_OPTIONS.h"
CBOP
C !ROUTINE: LAND_READ_PICKUP
C !INTERFACE:
SUBROUTINE LAND_READ_PICKUP( myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R LAND_READ_PICKUP
C | o Reads current state of land model from a pickup file
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global variables ===
#include "LAND_SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "LAND_PARAMS.h"
#include "LAND_VARS.h"
C == Routine Arguments ==
C myIter :: time-step number
C myThid :: Number of this instance
INTEGER myIter
INTEGER myThid
#ifdef ALLOW_LAND
C !LOCAL VARIABLES:
C fn :: character buffer for creating filename
C prec :: precision of pickup files
C k :: loop index
INTEGER prec, k
CHARACTER*(10) suff
CHARACTER*(MAX_LEN_FNAM) fn
CEOP
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( .NOT.land_pickup_read_mnc ) THEN
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(fn,'(A,I10.10)') 'pickup_land.',myIter
ELSE
CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
WRITE(fn,'(A,A10)') 'pickup_land.',suff
ENDIF
prec = precFloat64
IF ( land_oldPickup ) THEN
C- Read fields as consecutive records
CALL READ_REC_3D_RL( fn, prec, land_nLev,
& land_groundT, 1, myIter, myThid )
CALL READ_REC_3D_RL( fn, prec, land_nLev,
& land_groundW, 2, myIter, myThid )
ELSE
C- Read fields as consecutive records
CALL READ_REC_3D_RL( fn, prec, land_nLev,
& land_enthalp, 1, myIter, myThid )
CALL READ_REC_3D_RL( fn, prec, land_nLev,
& land_groundW, 2, myIter, myThid )
k=2*land_nLev
CALL READ_REC_3D_RL( fn, prec, 1,
& land_skinT, k+1, myIter, myThid )
CALL READ_REC_3D_RL( fn, prec, 1,
& land_hSnow, k+2, myIter, myThid )
CALL READ_REC_3D_RL( fn, prec, 1,
& land_snowAge,k+3, myIter, myThid )
ENDIF
ENDIF
#ifdef ALLOW_MNC
IF ( land_pickup_read_mnc ) THEN
DO k = 1,MAX_LEN_FNAM
fn(k:k) = ' '
ENDDO
WRITE(fn,'(A)') 'pickup_land'
CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
CALL MNC_CW_SET_UDIM(fn, 1, myThid)
CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
CALL MNC_CW_RL_R('D',fn,0,0,
& 'land_enthalp', land_enthalp, myThid)
CALL MNC_CW_RL_R('D',fn,0,0,
& 'land_groundW', land_groundW, myThid)
CALL MNC_CW_RL_R('D',fn,0,0,
& 'land_skinT', land_skinT, myThid)
CALL MNC_CW_RL_R('D',fn,0,0,
& 'land_hSnow', land_hSnow, myThid)
CALL MNC_CW_RL_R('D',fn,0,0,
& 'land_snAge', land_snowAge, myThid)
ENDIF
#endif
C- jmc: exchange is not really necessary for land model
C- and presently exchange S/R cannot work for 3d array where 3rd dim <> Nr
#endif /* ALLOW_LAND */
RETURN
END