| 1 |
cnh |
1.1 |
<html> |
| 2 |
|
|
<head> |
| 3 |
|
|
<title>/mnt/home/cnh/src/MITgcm_contrib_HEAD_2005_02_14/PRM/prmtop_mod.dir/prmtop.F90.html</title> |
| 4 |
|
|
<meta name="Generator" content="Vim/6.3"> |
| 5 |
|
|
<meta http-equiv="content-type" content="text/html; charset=UTF-8"> |
| 6 |
|
|
</head> |
| 7 |
|
|
<body bgcolor="#ffffff" text="#000000"> |
| 8 |
|
|
<pre> |
| 9 |
|
|
<font color="#a020f0">MODULE</font> PRMTop |
| 10 |
|
|
|
| 11 |
|
|
<font color="#a020f0">USE</font> EEsmfMod |
| 12 |
|
|
|
| 13 |
|
|
<font color="#0000ff">! Internal state type for a PRMTop component</font> |
| 14 |
|
|
<font color="#0000ff">! nSets :: Total number of component sets in this PRM.</font> |
| 15 |
|
|
<font color="#0000ff">! cTypeArr :: Array of nSets values that specify the </font> |
| 16 |
|
|
<font color="#0000ff">! :: component type of the components in</font> |
| 17 |
|
|
<font color="#0000ff">! :: a component set.</font> |
| 18 |
|
|
<font color="#0000ff">! ncTypeArr :: Number of entries in cTypeArr (should </font> |
| 19 |
|
|
<font color="#0000ff">! :: be the same as nSets).</font> |
| 20 |
|
|
<font color="#0000ff">! fPrefArr :: Array of prefix strings used to name</font> |
| 21 |
|
|
<font color="#0000ff">! :: the components.</font> |
| 22 |
|
|
<font color="#0000ff">! nFPrefArr :: Number of entries in fPrefArr (should</font> |
| 23 |
|
|
<font color="#0000ff">! :: be the same as nSets).</font> |
| 24 |
|
|
<font color="#0000ff">! nComps :: Number of components in each component</font> |
| 25 |
|
|
<font color="#0000ff">! :: set.</font> |
| 26 |
|
|
<font color="#0000ff">! nNComps :: Number of entries in the nComps list.</font> |
| 27 |
|
|
<font color="#0000ff">! :: (should be the same as nSets).</font> |
| 28 |
|
|
<font color="#0000ff">! topTimeStep :: Time step for PRMTop.</font> |
| 29 |
|
|
<font color="#0000ff">! topStartStep :: Time to start run.</font> |
| 30 |
|
|
<font color="#0000ff">! topEndTime :: Time to end run.</font> |
| 31 |
|
|
<font color="#0000ff">! topStartStep :: Starting step number.</font> |
| 32 |
|
|
<font color="#0000ff">! rootDirectory :: Root directory for all relative pathnames used</font> |
| 33 |
|
|
<font color="#0000ff">! :: in PRMTop</font> |
| 34 |
|
|
<font color="#2e8b57"><b>TYPE</b></font> PRMTopInternalState |
| 35 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: nSets |
| 36 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font>(<font color="#2e8b57"><b>LEN</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1024</font>), <font color="#2e8b57"><b>POINTER</b></font> :: cTypeArr(:) |
| 37 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: nCTypeArr |
| 38 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font>(<font color="#2e8b57"><b>LEN</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1024</font>), <font color="#2e8b57"><b>POINTER</b></font> :: fPrefArr(:) |
| 39 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: nFPrefArr |
| 40 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font>, <font color="#2e8b57"><b>POINTER</b></font> :: nComps(:) |
| 41 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: nNComps |
| 42 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: topTimeStep |
| 43 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: topStartTime |
| 44 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: topEndTime |
| 45 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: topStartStep |
| 46 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font>(<font color="#2e8b57"><b>LEN</b></font><font color="#a52a2a"><b>=</b></font>MAX_DIR_NAME), <font color="#2e8b57"><b>POINTER</b></font> :: rootDirectory |
| 47 |
|
|
<font color="#2e8b57"><b>END TYPE</b></font> |
| 48 |
|
|
|
| 49 |
|
|
<font color="#a020f0">CONTAINS</font> |
| 50 |
|
|
|
| 51 |
|
|
<font color="#a020f0">SUBROUTINE</font> ComponentsInit( theComponents ) |
| 52 |
|
|
<font color="#0000ff">!</font> |
| 53 |
|
|
<font color="#0000ff">! Set up the components for this experiment.</font> |
| 54 |
|
|
<font color="#0000ff">! This is done by allocating a series of combined component and state</font> |
| 55 |
|
|
<font color="#0000ff">! derived type objects. The returned list of components is then assigned </font> |
| 56 |
|
|
<font color="#0000ff">! to point to this set of objects.</font> |
| 57 |
|
|
|
| 58 |
|
|
<font color="#0000ff">! Routine arguments</font> |
| 59 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfComponentList ), <font color="#2e8b57"><b>POINTER</b></font> :: theComponents |
| 60 |
|
|
|
| 61 |
|
|
<font color="#0000ff">! Local variables</font> |
| 62 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( PRMTopInternalState ), <font color="#2e8b57"><b>POINTER</b></font> :: internalState |
| 63 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfGridComp ), <font color="#2e8b57"><b>ALLOCATABLE</b></font> :: coarseGridOcean(:) |
| 64 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfGridComp ), <font color="#2e8b57"><b>ALLOCATABLE</b></font> :: fineGridOceans(:) |
| 65 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfCplComp ), <font color="#2e8b57"><b>ALLOCATABLE</b></font> :: coarse2fine(:) |
| 66 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfCplComp ), <font color="#2e8b57"><b>ALLOCATABLE</b></font> :: fine2coarse(:) |
| 67 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfGridComp ), <font color="#2e8b57"><b>POINTER</b></font> :: gcArr(:) |
| 68 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfCplComp ), <font color="#2e8b57"><b>POINTER</b></font> :: ccArr(:) |
| 69 |
|
|
|
| 70 |
|
|
<font color="#0000ff">!</font> |
| 71 |
|
|
<font color="#0000ff">! Boot up ESMF</font> |
| 72 |
|
|
<font color="#a020f0">CALL</font> PRMBoot( <font color="#ff00ff">'prmtop.rc'</font>, internalState ) |
| 73 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( internalState%nFPrefArr <font color="#a52a2a"><b>.NE.</b></font> internalState%nSets ) <font color="#a52a2a"><b>THEN</b></font> |
| 74 |
|
|
<font color="#a52a2a"><b>STOP</b></font> <font color="#ff00ff">'ABNORMAL END: PRMTop found too few file prefix entries'</font> |
| 75 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 76 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( internalState%nCTypeArr <font color="#a52a2a"><b>.NE.</b></font> internalState%nSets ) <font color="#a52a2a"><b>THEN</b></font> |
| 77 |
|
|
<font color="#a52a2a"><b>STOP</b></font> <font color="#ff00ff">'ABNORMAL END: PRMTop found too few component type entries'</font> |
| 78 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 79 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( internalState%nNComps <font color="#a52a2a"><b>.NE.</b></font> internalState%nSets ) <font color="#a52a2a"><b>THEN</b></font> |
| 80 |
|
|
<font color="#a52a2a"><b>STOP</b></font> <font color="#ff00ff">'ABNORMAL END: PRMTop found too few component count entries'</font> |
| 81 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 82 |
|
|
<font color="#0000ff">!</font> |
| 83 |
|
|
<font color="#0000ff">! Allocate requested gridded and coupler components.</font> |
| 84 |
|
|
<font color="#a52a2a"><b>DO</b></font> I<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1</font>,internalState%nSets |
| 85 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( <font color="#6a5acd">TRIM</font>(internalState%cTypeArr(I)) <font color="#a52a2a"><b>.EQ.</b></font> <font color="#ff00ff">'gridded'</font> ) <font color="#a52a2a"><b>THEN</b></font> |
| 86 |
|
|
<font color="#a020f0">CALL</font> EEsmfAllocGridC( gcArr, internalState%nComps(I) ) |
| 87 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 88 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( <font color="#6a5acd">TRIM</font>(internalState%cTypeArr(I)) <font color="#a52a2a"><b>.EQ.</b></font> <font color="#ff00ff">'coupler'</font> ) <font color="#a52a2a"><b>THEN</b></font> |
| 89 |
|
|
<font color="#a020f0">CALL</font> EEsmfAllocCplC( ccArr, internalState%nComps(I) ) |
| 90 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 91 |
|
|
<font color="#a52a2a"><b>ENDDO</b></font> |
| 92 |
|
|
<font color="#a020f0">CALL</font> PRMShut( internalState ) |
| 93 |
|
|
<font color="#0000ff">! CALL EEsmfAllocGridC( coarseGridOcean, 1 )</font> |
| 94 |
|
|
<font color="#0000ff">! CALL EEsmfAllocGridC( fineGridOceans, nFine )</font> |
| 95 |
|
|
<font color="#0000ff">! CALL EEsmfAllocCplC( coarse2Fine, nFine )</font> |
| 96 |
|
|
<font color="#0000ff">! CALL EEsmfAllocCplC( fine2Coarse, 1 )</font> |
| 97 |
|
|
<font color="#0000ff">!</font> |
| 98 |
|
|
<font color="#0000ff">! Setup the components we need</font> |
| 99 |
|
|
<font color="#a020f0">CALL</font> EEsmfMakeGridComp(coarseGridOcean, |
| 100 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">I</font></span> <font color="#ff00ff">'cg.rc'</font>) |
| 101 |
|
|
<font color="#a020f0">CALL</font> EEsmfMakeGridComp( fineGridOceans, |
| 102 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> <font color="#ff00ff">'fg.rc'</font>) |
| 103 |
|
|
<font color="#a020f0">CALL</font> EEsmfMakeCplComp( fine2coarse, fineGridOceans, |
| 104 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> coarseGridOcean, |
| 105 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">I</font></span> <font color="#ff00ff">'f2c.rc'</font>) |
| 106 |
|
|
<font color="#a020f0">CALL</font> EEsmfMakeCplComp( coarse2fine, coarseGridOcean, |
| 107 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> fineGridOceans, |
| 108 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">I</font></span> <font color="#ff00ff">'c2f.rc'</font>) |
| 109 |
|
|
|
| 110 |
|
|
|
| 111 |
|
|
<font color="#a020f0">END SUBROUTINE</font> ComponentsInit |
| 112 |
|
|
|
| 113 |
|
|
<font color="#a020f0">SUBROUTINE</font> ComponentsRun( theComponents ) |
| 114 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfComponentList ), <font color="#2e8b57"><b>POINTER</b></font> :: theComponents |
| 115 |
|
|
<font color="#a020f0">END SUBROUTINE</font> ComponentsRun |
| 116 |
|
|
|
| 117 |
|
|
<font color="#a020f0">SUBROUTINE</font> ComponentsFinalize( theComponents ) |
| 118 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( EEsmfComponentList ), <font color="#2e8b57"><b>POINTER</b></font> :: theComponents |
| 119 |
|
|
<font color="#a020f0">END SUBROUTINE</font> ComponentsFinalize |
| 120 |
|
|
|
| 121 |
|
|
<font color="#a020f0">SUBROUTINE</font> PRMBoot( theResourceFile, theState ) |
| 122 |
|
|
|
| 123 |
|
|
<font color="#0000ff">! Routine arguments</font> |
| 124 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font><font color="#a52a2a"><b>*</b></font>(<font color="#a52a2a"><b>*</b></font>) :: theResourceFile |
| 125 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( PRMTopInternalState ), <font color="#2e8b57"><b>POINTER</b></font> :: theState |
| 126 |
|
|
|
| 127 |
|
|
<font color="#0000ff">! Local variables</font> |
| 128 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> rc |
| 129 |
|
|
<font color="#2e8b57"><b>TYPE</b></font> (ESMF_Config) :: cf |
| 130 |
|
|
<font color="#2e8b57"><b>INTEGER</b></font> :: nSets, nComps, I |
| 131 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font>(<font color="#2e8b57"><b>len</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1024</font>) :: fPref |
| 132 |
|
|
<font color="#2e8b57"><b>CHARACTER</b></font>(<font color="#2e8b57"><b>len</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1024</font>) :: cType |
| 133 |
|
|
|
| 134 |
|
|
<font color="#0000ff">! Boot PRMTop</font> |
| 135 |
|
|
|
| 136 |
|
|
<font color="#0000ff">! Allocate a PRMTop internal state object</font> |
| 137 |
|
|
<font color="#a52a2a"><b>ALLOCATE</b></font>( theState ) |
| 138 |
|
|
|
| 139 |
|
|
<font color="#0000ff">! Read PRM config</font> |
| 140 |
|
|
cf <font color="#a52a2a"><b>=</b></font> ESMF_ConfigCreate(rc) |
| 141 |
|
|
<font color="#a020f0">CALL</font> ESMF_ConfigLoadFile( cf, theResourceFile, rc <font color="#a52a2a"><b>=</b></font> rc) |
| 142 |
|
|
|
| 143 |
|
|
<font color="#0000ff">! Find how many sets of components have been requested.</font> |
| 144 |
|
|
<font color="#0000ff">! If the number requested is less than 1 it is an error.</font> |
| 145 |
|
|
<font color="#a020f0">CALL</font> EEsmf_ReadConfig( cf, label<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'nsets:'</font>, <font color="#a52a2a"><b>default</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1</font>, |
| 146 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> rVal<font color="#a52a2a"><b>=</b></font>theState%nSets, rc<font color="#a52a2a"><b>=</b></font>rc ) |
| 147 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( theState%nSets <font color="#a52a2a"><b><=</b></font> <font color="#ff00ff">0</font> ) <font color="#a52a2a"><b>THEN</b></font> |
| 148 |
|
|
<font color="#a52a2a"><b>STOP</b></font> <font color="#ff00ff">'ABNORMAL END:: PRMTop - nSets <= 0'</font> |
| 149 |
|
|
<font color="#a52a2a"><b>ENDIF</b></font> |
| 150 |
|
|
|
| 151 |
|
|
<font color="#0000ff">! Get basic details for each components set</font> |
| 152 |
|
|
<font color="#a52a2a"><b>ALLOCATE</b></font>( theState%cTypeArr(theState%nSets) ) |
| 153 |
|
|
<font color="#a52a2a"><b>ALLOCATE</b></font>( theState%fPrefArr(theState%nSets) ) |
| 154 |
|
|
<font color="#a52a2a"><b>ALLOCATE</b></font>( theState%nComps(theState%nSets) ) |
| 155 |
|
|
theState%nCTypeArr <font color="#a52a2a"><b>=</b></font> <font color="#ff00ff">0</font> |
| 156 |
|
|
theState%nFPrefArr <font color="#a52a2a"><b>=</b></font> <font color="#ff00ff">0</font> |
| 157 |
|
|
theState%nNComps <font color="#a52a2a"><b>=</b></font> <font color="#ff00ff">0</font> |
| 158 |
|
|
|
| 159 |
|
|
<font color="#a52a2a"><b>DO</b></font> I<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1</font>,theState%nSets |
| 160 |
|
|
<font color="#0000ff">! Get the component type for each component set.</font> |
| 161 |
|
|
<font color="#a020f0">CALL</font> EEsmf_ReadConfig( cf, label<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'ctype:'</font>, <font color="#a52a2a"><b>default</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'gridded'</font>, <font color="#6a5acd">index</font><font color="#a52a2a"><b>=</b></font>I, |
| 162 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> rVal<font color="#a52a2a"><b>=</b></font>theState%cTypeArr(I), rc<font color="#a52a2a"><b>=</b></font>rc ) |
| 163 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( rc <font color="#a52a2a"><b>.EQ.</b></font> ESMF_SUCCESS ) theState%nCTypeArr <font color="#a52a2a"><b>=</b></font> theState%nCTypeA<span style="background-color: #ffff00"><font color="#0000ff">rr+1</font></span> |
| 164 |
|
|
<font color="#0000ff">! Get the number of components to create for each component set.</font> |
| 165 |
|
|
<font color="#a020f0">CALL</font> EEsmf_ReadConfig( cf, label<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'counts:'</font>, <font color="#a52a2a"><b>default</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">1</font>, <font color="#6a5acd">index</font><font color="#a52a2a"><b>=</b></font>I, |
| 166 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> rVal<font color="#a52a2a"><b>=</b></font>theState%nComps(I), rc<font color="#a52a2a"><b>=</b></font>rc ) |
| 167 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( rc <font color="#a52a2a"><b>.EQ.</b></font> ESMF_SUCCESS ) theState%nNComps <font color="#a52a2a"><b>=</b></font> theState%nNComps<font color="#a52a2a"><b>+</b></font><font color="#ff00ff">1</font> |
| 168 |
|
|
<font color="#0000ff">! Get the prefix label used to distinguish each component set.</font> |
| 169 |
|
|
<font color="#a020f0">CALL</font> EEsmf_ReadConfig( cf, label<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'preflist:'</font>, <font color="#a52a2a"><b>default</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'cg'</font>, <font color="#6a5acd">index</font><span style="background-color: #ffff00"><font color="#0000ff">=I, </font></span> |
| 170 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> rVal<font color="#a52a2a"><b>=</b></font>theState%fPrefArr(I), rc<font color="#a52a2a"><b>=</b></font>rc ) |
| 171 |
|
|
<font color="#a52a2a"><b>IF</b></font> ( rc <font color="#a52a2a"><b>.EQ.</b></font> ESMF_SUCCESS ) theState%nFPrefArr <font color="#a52a2a"><b>=</b></font> theState%nFPrefA<span style="background-color: #ffff00"><font color="#0000ff">rr+1</font></span> |
| 172 |
|
|
<font color="#a52a2a"><b>ENDDO</b></font> |
| 173 |
|
|
|
| 174 |
|
|
<font color="#a020f0">CALL</font> EEsmf_ReadConfig( cf, label<font color="#a52a2a"><b>=</b></font><font color="#ff00ff">'topStartTime:'</font>, <font color="#a52a2a"><b>default</b></font><font color="#a52a2a"><b>=</b></font><font color="#ff00ff">0</font>, |
| 175 |
|
|
<span style="background-color: #ffff00"><font color="#0000ff">&</font></span> rVal<font color="#a52a2a"><b>=</b></font>theState%topStartTime, rc<font color="#a52a2a"><b>=</b></font>rc ) |
| 176 |
|
|
|
| 177 |
|
|
<font color="#a020f0">END SUBROUTINE</font> PRMBoot |
| 178 |
|
|
|
| 179 |
|
|
<font color="#a020f0">SUBROUTINE</font> PRMShut( theState ) |
| 180 |
|
|
|
| 181 |
|
|
<font color="#0000ff">! Routine arguments</font> |
| 182 |
|
|
<font color="#2e8b57"><b>TYPE</b></font>( PRMTopInternalState ), <font color="#2e8b57"><b>POINTER</b></font> :: theState |
| 183 |
|
|
|
| 184 |
|
|
<font color="#0000ff">! Free PRM internal data</font> |
| 185 |
|
|
<font color="#a52a2a"><b>DEALLOCATE</b></font>( theState%fPrefArr ) |
| 186 |
|
|
<font color="#a52a2a"><b>DEALLOCATE</b></font>( theState%cTypeArr ) |
| 187 |
|
|
<font color="#a52a2a"><b>DEALLOCATE</b></font>( theState%nComps ) |
| 188 |
|
|
|
| 189 |
|
|
<font color="#0000ff">! Free PRMTop internal state object</font> |
| 190 |
|
|
<font color="#a52a2a"><b>DEALLOCATE</b></font>( theState ) |
| 191 |
|
|
|
| 192 |
|
|
<font color="#a020f0">END SUBROUTINE</font> PRMShut |
| 193 |
|
|
|
| 194 |
|
|
<font color="#a020f0">END MODULE</font> PRMTop |
| 195 |
|
|
</pre> |
| 196 |
|
|
</body> |
| 197 |
|
|
</html> |
Parent Directory
| 
Revision Log
| 
Revision Graph