/[MITgcm]/MITgcm_contrib/jscott/code_changed/thsice_read_pickup.F
ViewVC logotype

Contents of /MITgcm_contrib/jscott/code_changed/thsice_read_pickup.F

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


Revision 1.2 - (show annotations) (download)
Tue Aug 21 15:59:49 2007 UTC (19 years ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -1 lines
FILE REMOVED
remove obsolete directory

1 C $Header: /u/gcmpack/MITgcm_contrib/jscott/code_changed/thsice_read_pickup.F,v 1.1 2006/08/11 19:29:23 jscott Exp $
2 C $Name: $
3
4 #include "THSICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: THSICE_READ_PICKUP
8 C !INTERFACE:
9 SUBROUTINE THSICE_READ_PICKUP( prec, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | S/R THSICE_READ_PICKUP
14 C | o Read thsice pickup file
15 C *==========================================================*
16 C \ev
17
18 C !USES:
19 IMPLICIT NONE
20
21 C === Global variables ===
22 #include "SIZE.h"
23 #include "EEPARAMS.h"
24 #include "PARAMS.h"
25 #include "THSICE_PARAMS.h"
26 #include "THSICE_VARS.h"
27
28 C !INPUT/OUTPUT PARAMETERS:
29 C == Routine arguments ==
30 INTEGER prec
31 INTEGER myIter
32 INTEGER myThid
33 CEOP
34
35 #ifdef ALLOW_THSICE
36
37 C == Local variables ==
38 CHARACTER*(MAX_LEN_FNAM) fn
39
40 IF ( .NOT. thSIce_pickup_write_mnc ) THEN
41
42 WRITE(fn,'(A,I10.10)') 'pickup_ic.',myIter
43 CALL MDSREADFIELD(fn,prec,'RL',1,iceMask, 1,myThid)
44 CALL MDSREADFIELD(fn,prec,'RL',1,iceHeight, 2,myThid)
45 CALL MDSREADFIELD(fn,prec,'RL',1,snowHeight,3,myThid)
46 CALL MDSREADFIELD(fn,prec,'RL',1,Tsrf, 4,myThid)
47 CALL MDSREADFIELD(fn,prec,'RL',1,Tice1, 5,myThid)
48 CALL MDSREADFIELD(fn,prec,'RL',1,Tice2, 6,myThid)
49 CALL MDSREADFIELD(fn,prec,'RL',1,Qice1, 7,myThid)
50 CALL MDSREADFIELD(fn,prec,'RL',1,Qice2, 8,myThid)
51 CALL MDSREADFIELD(fn,prec,'RL',1,snowAge, 9,myThid)
52
53 IF ( stepFwd_oceMxL .AND. startIceModel.LE.0 ) THEN
54 CALL MDSREADFIELD(fn,prec,'RL',1,tOceMxL, 10,myThid)
55 CALL MDSREADFIELD(fn,prec,'RL',1,sOceMxL, 11,myThid)
56 ENDIF
57
58 ENDIF
59
60 #ifdef ALLOW_MNC
61 IF ( thSIce_pickup_write_mnc ) THEN
62 WRITE(fn,'(A)') 'pickup_ic'
63 CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
64 CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
65 CALL MNC_CW_SET_UDIM(fn, 1, myThid)
66 CALL MNC_CW_RL_R('D',fn,0,0,'iceMask', iceMask, myThid)
67 CALL MNC_CW_RL_R('D',fn,0,0,'iceHeight', iceHeight, myThid)
68 CALL MNC_CW_RL_R('D',fn,0,0,'snowHeight',snowHeight,myThid)
69 CALL MNC_CW_RL_R('D',fn,0,0,'Tsrf', Tsrf, myThid)
70 CALL MNC_CW_RL_R('D',fn,0,0,'Tice1', Tice1, myThid)
71 CALL MNC_CW_RL_R('D',fn,0,0,'Tice2', Tice1, myThid)
72 CALL MNC_CW_RL_R('D',fn,0,0,'Qice1', Qice1, myThid)
73 CALL MNC_CW_RL_R('D',fn,0,0,'Qice2', Qice2, myThid)
74 CALL MNC_CW_RL_R('D',fn,0,0,'snowAge', snowAge, myThid)
75 IF ( stepFwd_oceMxL ) THEN
76 CALL MNC_CW_RL_R('D',fn,0,0,'tOceMxL',tOceMxL,myThid)
77 CALL MNC_CW_RL_R('D',fn,0,0,'sOceMxL',sOceMxL,myThid)
78 ENDIF
79 ENDIF
80 #endif /* ALLOW_MNC */
81
82 #endif /* ALLOW_THSICE */
83 RETURN
84 END
85

  ViewVC Help
Powered by ViewVC 1.1.22