File indexing completed on 2024-03-02 06:10:17 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
5ed655852f Jean*0001 #include "COST_OPTIONS.h"
eaa2114d11 Jean*0002 #ifdef ALLOW_CTRL
0003 # include "CTRL_OPTIONS.h"
0004 #endif
2dcaa8b9a5 Patr*0005
7883e4f1a1 Jean*0006 SUBROUTINE COST_FINAL( myThid )
2dcaa8b9a5 Patr*0007
0008
720be40b89 Patr*0009
2dcaa8b9a5 Patr*0010
0011
0012
0013
0014
720be40b89 Patr*0015
2dcaa8b9a5 Patr*0016
0017
7883e4f1a1 Jean*0018 IMPLICIT NONE
2dcaa8b9a5 Patr*0019
0020
0021 #include "EEPARAMS.h"
0022 #include "SIZE.h"
c28cf14cd7 Patr*0023 #include "PARAMS.h"
2dcaa8b9a5 Patr*0024
0025 #include "cost.h"
9829fd7e0c Patr*0026 #ifdef ALLOW_CTRL
5cf4364659 Mart*0027 # include "CTRL_SIZE.h"
4d72283393 Mart*0028 # include "CTRL.h"
9829fd7e0c Patr*0029 #endif
ade85a36e7 Patr*0030 #ifdef ALLOW_DIC
0031 # include "DIC_COST.h"
0032 #endif
64c318b5ee Patr*0033 #ifdef ALLOW_COST_SHELFICE
0034 # include "SHELFICE_COST.h"
0035 #endif
0036
8f14b8ea71 Gael*0037 #ifdef ALLOW_PROFILES
0038 # include "PROFILES_SIZE.h"
0039 # include "profiles.h"
0040 #endif
0041
2dcaa8b9a5 Patr*0042
7883e4f1a1 Jean*0043 INTEGER myThid
2dcaa8b9a5 Patr*0044
bbf42b7711 Patr*0045 #ifdef ALLOW_COST
2dcaa8b9a5 Patr*0046
7883e4f1a1 Jean*0047 INTEGER bi,bj
0048 _RL glob_fc, loc_fc
8f14b8ea71 Gael*0049 #ifdef ALLOW_PROFILES
3bafcf6020 Timo*0050 INTEGER num_file,num_var
8f14b8ea71 Gael*0051 #endif
3bafcf6020 Timo*0052 CHARACTER*(MAX_LEN_MBUF) msgBuf
2dcaa8b9a5 Patr*0053
0054
0055
869864d4b6 Patr*0056 #ifdef ALLOW_SEAICE
2b959ba38e Mart*0057 IF (useSEAICE) CALL SEAICE_COST_FINAL( myThid )
869864d4b6 Patr*0058 #endif
0059
1d6fceaddf Mart*0060 #ifdef ALLOW_SHELFICE
3bafcf6020 Timo*0061 IF (useShelfice) CALL SHELFICE_COST_FINAL (myThid)
96b006450c dngo*0062 #endif
0063
0064 #if (defined(ALLOW_STREAMICE) && defined(ALLOW_COST_STREAMICE))
0065 IF (useStreamice) CALL STREAMICE_COST_FINAL (myThid)
1d6fceaddf Mart*0066 #endif
0067
6c747cb1b2 Patr*0068 #ifdef ALLOW_THSICE
eaa2114d11 Jean*0069 IF (useThSIce) CALL THSICE_COST_FINAL (myThid)
6c747cb1b2 Patr*0070 #endif
0071
98264b2c3d Gael*0072 #ifdef ALLOW_ECCO
8f14b8ea71 Gael*0073 IF (useECCO) CALL ECCO_COST_FINAL (myThid)
98264b2c3d Gael*0074 #endif
720be40b89 Patr*0075
98264b2c3d Gael*0076 #ifdef ALLOW_COST_STATE_FINAL
9eb96e5404 Patr*0077 CALL COST_STATE_FINAL (myThid)
5ed655852f Jean*0078
98264b2c3d Gael*0079
0080
0081
0082 #endif
720be40b89 Patr*0083
98264b2c3d Gael*0084 #ifdef ALLOW_COST_VECTOR
0085
0086 CALL COST_VECTOR (myThid)
0087 #endif
720be40b89 Patr*0088
2f1693fad8 Patr*0089 # ifdef ALLOW_COST_TEST
bbf42b7711 Patr*0090 CALL COST_TEST (myThid)
2f1693fad8 Patr*0091 # endif
98264b2c3d Gael*0092
2f1693fad8 Patr*0093 # ifdef ALLOW_COST_ATLANTIC_HEAT
720be40b89 Patr*0094 CALL COST_ATLANTIC_HEAT (myThid)
2f1693fad8 Patr*0095 # endif
98264b2c3d Gael*0096
913151f332 Davi*0097 #ifdef ALLOW_COST_HFLUXM
0098 CALL COST_HFLUX (myThid)
3bafcf6020 Timo*0099
913151f332 Davi*0100 #endif
98264b2c3d Gael*0101
913151f332 Davi*0102 #ifdef ALLOW_COST_TEMP
0103 CALL COST_TEMP (myThid)
98264b2c3d Gael*0104
913151f332 Davi*0105 #endif
720be40b89 Patr*0106
11c3150c71 Mart*0107 #ifdef ALLOW_COST_DEPTH
0108 CALL COST_DEPTH( myThid )
0109 #endif
0110
3bafcf6020 Timo*0111 WRITE(msgBuf,'(A,D22.15)') ' early fc = ', fc
0112 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0113 & SQUEEZE_RIGHT, myThid )
7883e4f1a1 Jean*0114
2dcaa8b9a5 Patr*0115
7883e4f1a1 Jean*0116 loc_fc = 0.
0117 DO bj = myByLo(myThid), myByHi(myThid)
0118 DO bi = myBxLo(myThid), myBxHi(myThid)
2dcaa8b9a5 Patr*0119
a9ded497a5 Gael*0120 #ifdef ALLOW_COST_TEST
3bafcf6020 Timo*0121 WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0122 & ' --> objf_test(bi,bj) = ', objf_test(bi,bj)
a9ded497a5 Gael*0123 #endif
0124 #ifdef ALLOW_COST_TRACER
3bafcf6020 Timo*0125 WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0126 & ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
a9ded497a5 Gael*0127 #endif
cda1c18f72 Jean*0128 #ifdef ALLOW_COST_ATLANTIC_HEAT
3bafcf6020 Timo*0129 WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0130 & ' --> objf_atl(bi,bj) = ', objf_atl(bi,bj)
98264b2c3d Gael*0131 #endif
913151f332 Davi*0132 #ifdef ALLOW_COST_TEMP
3bafcf6020 Timo*0133 WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0134 & ' --> objf_temp_tut(bi,bj) = ', objf_temp_tut(bi,bj)
913151f332 Davi*0135 #endif
0136 #ifdef ALLOW_COST_HFLUXM
3bafcf6020 Timo*0137 WRITE(standardMessageUnit,'(A,D22.15)')
14021e1fda Davi*0138 & ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
913151f332 Davi*0139 #endif
11c3150c71 Mart*0140 #ifdef ALLOW_COST_DEPTH
3bafcf6020 Timo*0141 WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0142 & ' --> objf_depth(bi,bj) = ', objf_depth(bi,bj)
0143 #endif
2dcaa8b9a5 Patr*0144
7883e4f1a1 Jean*0145 tile_fc(bi,bj) = tile_fc(bi,bj)
a9ded497a5 Gael*0146 #ifdef ALLOW_COST_TEST
bbf42b7711 Patr*0147 & + mult_test * objf_test(bi,bj)
a9ded497a5 Gael*0148 #endif
0149 #ifdef ALLOW_COST_TRACER
bbf42b7711 Patr*0150 & + mult_tracer * objf_tracer(bi,bj)
a9ded497a5 Gael*0151 #endif
cda1c18f72 Jean*0152 #ifdef ALLOW_COST_ATLANTIC_HEAT
720be40b89 Patr*0153 & + mult_atl * objf_atl(bi,bj)
616600b8d2 Patr*0154 #endif
913151f332 Davi*0155 #ifdef ALLOW_COST_TEMP
14021e1fda Davi*0156 & + mult_temp_tut * objf_temp_tut(bi,bj)
913151f332 Davi*0157 #endif
0158 #ifdef ALLOW_COST_HFLUXM
14021e1fda Davi*0159 & + mult_hflux_tut * objf_hflux_tut(bi,bj)
913151f332 Davi*0160 #endif
11c3150c71 Mart*0161 #ifdef ALLOW_COST_DEPTH
0162 & + mult_depth * objf_depth(bi,bj)
0163 #endif
8f14b8ea71 Gael*0164
0165 #ifdef ALLOW_PROFILES
3bafcf6020 Timo*0166 IF (.NOT.useECCO) THEN
0167 DO num_file=1,NFILESPROFMAX
0168 DO num_var=1,NVARMAX
0169 tile_fc(bi,bj) = tile_fc(bi,bj)
8f14b8ea71 Gael*0170 & + mult_profiles(num_file,num_var)
0171 & *objf_profiles(num_file,num_var,bi,bj)
3bafcf6020 Timo*0172 ENDDO
0173 ENDDO
0174 ENDIF
8f14b8ea71 Gael*0175 #endif
0176
7883e4f1a1 Jean*0177 loc_fc = loc_fc + tile_fc(bi,bj)
8f14b8ea71 Gael*0178
7883e4f1a1 Jean*0179 ENDDO
0180 ENDDO
2dcaa8b9a5 Patr*0181
3bafcf6020 Timo*0182 WRITE(msgBuf,'(A,D22.15)') ' local fc = ', loc_fc
0183 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0184 & SQUEEZE_RIGHT, myThid )
2dcaa8b9a5 Patr*0185
0186
7883e4f1a1 Jean*0187 CALL GLOBAL_SUM_TILE_RL( tile_fc, glob_fc, myThid )
0188 _BEGIN_MASTER( myThid )
0189 fc = fc + glob_fc
0190 _END_MASTER( myThid )
2dcaa8b9a5 Patr*0191
8a270036d8 Gael*0192
7883e4f1a1 Jean*0193 _BEGIN_MASTER( myThid )
0194 fc = fc + glofc
0195 _END_MASTER( myThid )
8a270036d8 Gael*0196
a35895498f Patr*0197 #ifdef ALLOW_DIC_COST
ade85a36e7 Patr*0198
0199 fc = totcost
0200 #endif
0201
3bafcf6020 Timo*0202 WRITE(msgBuf,'(A,D22.15)') ' global fc = ', fc
0203 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0204 & SQUEEZE_RIGHT, myThid )
9eb96e5404 Patr*0205
2a878d427b Jean*0206
0207
0208 CALL TURNOFF_MODEL_IO( 0, myThid )
c28cf14cd7 Patr*0209
bbf42b7711 Patr*0210 #endif /* ALLOW_COST */
2dcaa8b9a5 Patr*0211
3bafcf6020 Timo*0212 RETURN
0213 END