Changeset 4177
- Timestamp:
- 2013-11-11T12:15:42+01:00 (10 years ago)
- Location:
- branches/2013/dev_CMCC_2013
- Files:
-
- 1 deleted
- 20 edited
- 1 copied
-
DOC/TexFiles/Chapters/Chap_DIA.tex (modified) (9 diffs)
-
NEMOGCM/ARCH/OLD/arch-PW7_METO.fcm (deleted)
-
NEMOGCM/ARCH/arch-PW7_METO.fcm (copied) (copied from trunk/NEMOGCM/ARCH/arch-PW7_METO.fcm)
-
NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 (modified) (11 diffs)
-
NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (9 diffs)
-
NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90 (modified) (4 diffs)
-
NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (5 diffs)
-
NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/SAS_SRC/daymod.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90 (modified) (2 diffs)
-
NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh (modified) (6 diffs)
-
NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh (modified) (2 diffs)
-
NEMOGCM/TOOLS/maketools (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_CMCC_2013/DOC/TexFiles/Chapters/Chap_DIA.tex
r4175 r4177 362 362 \subsubsection{Use of Groups} 363 363 364 Groups can be used for 2 purposes. Firstly, the group can be used to define common attributes to be shared by the elements of the group through theinheritance. In the following example, we define a group of field that will share a common grid ''grid\_T\_2D''. Note that for the field ''toce'', we overwrite the grid definition inherited from the group by ''grid\_T\_3D''.364 Groups can be used for 2 purposes. Firstly, the group can be used to define common attributes to be shared by the elements of the group through inheritance. In the following example, we define a group of field that will share a common grid ''grid\_T\_2D''. Note that for the field ''toce'', we overwrite the grid definition inherited from the group by ''grid\_T\_3D''. 365 365 \vspace{-20pt} 366 366 \begin{alltt} {{\scriptsize … … 386 386 \end{verbatim} 387 387 }}\end{alltt} 388 that can be directly include in a file through the following syntax:388 that can be directly included in a file through the following syntax: 389 389 \vspace{-20pt} 390 390 \begin{alltt} {{\scriptsize … … 466 466 \end{verbatim} 467 467 }}\end{alltt} 468 However it is often very convienent to define the file name with the name of the experi ence, the output file frequency and the date of the beginning and the end of the simulation (which are informations stored either in the namelist or in the XML file). To do so, we added the following rule: if the id of the tag file is ''fileN''(where N = 1 to 99) or one of the predefined section or mooring(see next subsection), the following part of the name and the name\_suffix (that can be inherited) will be automatically replaced by:\\468 However it is often very convienent to define the file name with the name of the experiment, the output file frequency and the date of the beginning and the end of the simulation (which are informations stored either in the namelist or in the XML file). To do so, we added the following rule: if the id of the tag file is ''fileN''(where N = 1 to 99) or one of the predefined sections or moorings (see next subsection), the following part of the name and the name\_suffix (that can be inherited) will be automatically replaced by:\\ 469 469 \\ 470 470 \begin{tabular}{|p{4cm}|p{8cm}|} … … 474 474 \hline 475 475 \centering @expname@ & 476 the experi encename (from cn\_exp in the namelist) \\476 the experiment name (from cn\_exp in the namelist) \\ 477 477 \hline 478 478 \centering @freq@ & … … 590 590 file\_definition & 591 591 encapsulates the definition of all the files that will be outputted & 592 enabled, min\_digits, name, name\_suffix, output\_level, split\_f ormat, split\_freq, sync\_freq, type, src &592 enabled, min\_digits, name, name\_suffix, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src & 593 593 context & 594 594 file or file\_group \\ … … 596 596 file\_group & 597 597 encapsulates a group of files that will be outputted & 598 enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_f ormat, split\_freq, sync\_freq, type, src &598 enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src & 599 599 file\_definition, file\_group & 600 600 file or file\_group \\ … … 602 602 file & 603 603 define the contents of a file to be outputted & 604 enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_f ormat, split\_freq, sync\_freq, type, src &604 enabled, description, id, min\_digits, name, name\_suffix, output\_freq, output\_level, split\_freq\_format, split\_freq, sync\_freq, type, src & 605 605 file\_definition, file\_group & 606 606 field \\ … … 775 775 field family \\ 776 776 \hline 777 split\_f ormat&778 date format used in the name of splitted output files. can be spécified using the following syntaxe: \%y, \%mo, \%d, \%h \%mi and \%s&779 split\_f ormat= "\%yy\%mom\%dd" &777 split\_freq & 778 frequency at which to temporally split output files. Units can be ts (timestep), y, mo, d, h, mi, s. Useful for long runs to prevent over-sized output files.& 779 split\_freq="1mo" & 780 780 file family \\ 781 781 \hline 782 split\_freq & 783 split output files frequency. units can be ts (timestep), y, mo, d, h, mi, s. & 784 split\_freq="1mo" & 782 split\_freq\-\_format & 783 date format used in the name of temporally split output files. Can be specified 784 using the following syntaxes: \%y, \%mo, \%d, \%h \%mi and \%s & 785 split\_freq\_format= "\%y\%mo\%d" & 785 786 file family \\ 786 787 \hline … … 812 813 \hline 813 814 type (1)& 814 specify if the output files must be split(multiple\_file) or not (one\_file) &815 specify if the output files are to be split spatially (multiple\_file) or not (one\_file) & 815 816 type="multiple\_file" & 816 817 file familly \\ -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r3918 r4177 185 185 INTEGER :: ji,jj,jk 186 186 INTEGER :: ispongearea, ilci, ilcj 187 REAL(wp) :: z1spongearea 188 REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 187 LOGICAL :: ll_spdone 188 REAL(wp) :: z1spongearea, zramp 189 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 189 190 190 191 #if defined SPONGE || defined SPONGE_TOP 191 192 CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 193 194 ispongearea = 2 + 2 * Agrif_irhox() 195 ilci = nlci - ispongearea 196 ilcj = nlcj - ispongearea 197 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 198 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 192 ll_spdone=.TRUE. 193 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 194 ! Define ramp from boundaries towards domain interior 195 ! at T-points 196 ! Store it in ztabramp 197 ll_spdone=.FALSE. 198 199 CALL wrk_alloc( jpi, jpj, ztabramp ) 200 201 ispongearea = 2 + 2 * Agrif_irhox() 202 ilci = nlci - ispongearea 203 ilcj = nlcj - ispongearea 204 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 205 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 206 207 ztabramp(:,:) = 0. 208 209 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 210 DO jj = 1, jpj 211 IF ( umask(2,jj,1) == 1._wp ) THEN 212 DO ji = 2, ispongearea 213 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 214 END DO 215 ENDIF 216 ENDDO 217 ENDIF 218 219 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 220 DO jj = 1, jpj 221 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 222 DO ji = ilci+1,nlci-1 223 zramp = (ji - (ilci+1) ) * z1spongearea 224 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 225 ENDDO 226 ENDIF 227 ENDDO 228 ENDIF 229 230 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 231 DO ji = 1, jpi 232 IF ( vmask(ji,2,1) == 1._wp ) THEN 233 DO jj = 2, ispongearea 234 zramp = ( ispongearea-jj ) * z1spongearea 235 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 236 END DO 237 ENDIF 238 ENDDO 239 ENDIF 240 241 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 242 DO ji = 1, jpi 243 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 244 DO jj = ilcj+1,nlcj-1 245 zramp = (jj - (ilcj+1) ) * z1spongearea 246 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 247 END DO 248 ENDIF 249 ENDDO 250 ENDIF 251 252 ENDIF 199 253 200 254 ! Tracers 201 255 IF( .NOT. spongedoneT ) THEN 202 zlocalviscsponge(:,:) = 0.203 256 spe1ur(:,:) = 0. 204 257 spe2vr(:,:) = 0. 205 258 206 259 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 207 DO ji = 2, ispongearea208 zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea209 ENDDO210 spe1ur(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) &211 & + zlocalviscsponge(3:ispongearea ,: ) ) & 212 & * e2u(2:ispongearea-1,: ) / e1u(2:ispongearea-1,: )213 spe2vr(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) &214 & + zlocalviscsponge(2:ispongearea,2 :jpj ) ) &215 & * e1v(2:ispongearea ,1:jpjm1) / e2v(2:ispongearea,1:jpjm1)260 spe1ur(2:ispongearea-1,: ) = visc_tra & 261 & * 0.5 * ( ztabramp(2:ispongearea-1,: ) & 262 & + ztabramp(3:ispongearea ,: ) ) & 263 & * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:) 264 265 spe2vr(2:ispongearea ,1:jpjm1 ) = visc_tra & 266 & * 0.5 * ( ztabramp(2:ispongearea ,1:jpjm1) & 267 & + ztabramp(2:ispongearea,2 :jpj ) ) & 268 & * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1) 216 269 ENDIF 217 270 218 271 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 219 DO ji = ilci+1,nlci-1 220 zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 221 ENDDO 222 223 spe1ur(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) & 224 & + zlocalviscsponge(ilci+2:nlci-1,:) ) & 225 & * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 226 227 spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) & 228 & + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) & 229 & * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 272 spe1ur(ilci+1:nlci-2,: ) = visc_tra & 273 & * 0.5 * ( ztabramp(ilci+1:nlci-2,: ) & 274 & + ztabramp(ilci+2:nlci-1,: ) ) & 275 & * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 276 277 spe2vr(ilci+1:nlci-1,1:jpjm1 ) = visc_tra & 278 & * 0.5 * ( ztabramp(ilci+1:nlci-1,1:jpjm1) & 279 & + ztabramp(ilci+1:nlci-1,2:jpj ) ) & 280 & * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 230 281 ENDIF 231 282 232 283 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 233 DO jj = 2, ispongearea 234 zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 235 ENDDO 236 spe1ur(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea ) & 237 & + zlocalviscsponge(2:jpi ,2:ispongearea) ) & 284 spe1ur(1:jpim1,2:ispongearea ) = visc_tra & 285 & * 0.5 * ( ztabramp(1:jpim1,2:ispongearea ) & 286 & + ztabramp(2:jpi ,2:ispongearea ) ) & 238 287 & * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 239 288 240 spe2vr(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) & 241 & + zlocalviscsponge(:,3:ispongearea ) ) & 289 spe2vr(: ,2:ispongearea-1) = visc_tra & 290 & * 0.5 * ( ztabramp(: ,2:ispongearea-1) & 291 & + ztabramp(: ,3:ispongearea ) ) & 242 292 & * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 243 293 ENDIF 244 294 245 295 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 246 DO jj = ilcj+1,nlcj-1 247 zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 248 ENDDO 249 spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) & 250 & + zlocalviscsponge(2:jpi ,ilcj+1:nlcj-1) ) & 296 spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra & 297 & * 0.5 * ( ztabramp(1:jpim1,ilcj+1:nlcj-1) & 298 & + ztabramp(2:jpi ,ilcj+1:nlcj-1) ) & 251 299 & * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 252 spe2vr(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) & 253 & + zlocalviscsponge(:,ilcj+2:nlcj-1) ) & 300 301 spe2vr(: ,ilcj+1:nlcj-2) = visc_tra & 302 & * 0.5 * ( ztabramp(: ,ilcj+1:nlcj-2) & 303 & + ztabramp(: ,ilcj+2:nlcj-1) ) & 254 304 & * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 255 305 ENDIF … … 259 309 ! Dynamics 260 310 IF( .NOT. spongedoneU ) THEN 261 zlocalviscsponge(:,:) = 0.262 311 spe1ur2(:,:) = 0. 263 312 spe2vr2(:,:) = 0. 264 313 265 314 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 266 DO ji = 2, ispongearea 267 zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 268 ENDDO 269 spe1ur2(2:ispongearea-1,: ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,: ) & 270 & + zlocalviscsponge(3:ispongearea,: ) ) 271 spe2vr2(2:ispongearea ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea ,1:jpjm1) & 272 & + zlocalviscsponge(2:ispongearea,2:jpj) ) 315 spe1ur2(2:ispongearea-1,: ) = visc_dyn & 316 & * 0.5 * ( ztabramp(2:ispongearea-1,: ) & 317 & + ztabramp(3:ispongearea ,: ) ) 318 spe2vr2(2:ispongearea ,1:jpjm1) = visc_dyn & 319 & * 0.5 * ( ztabramp(2:ispongearea ,1:jpjm1) & 320 & + ztabramp(2:ispongearea ,2:jpj ) ) 273 321 ENDIF 274 322 275 323 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 276 DO ji = ilci+1,nlci-1 277 zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 278 ENDDO 279 spe1ur2(ilci+1:nlci-2,: ) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-2,:) & 280 & + zlocalviscsponge(ilci+2:nlci-1,:) ) 281 spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * ( zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) & 282 & + zlocalviscsponge(ilci+1:nlci-1,2:jpj ) ) 324 spe1ur2(ilci+1:nlci-2 ,: ) = visc_dyn & 325 & * 0.5 * ( ztabramp(ilci+1:nlci-2, : ) & 326 & + ztabramp(ilci+2:nlci-1, : ) ) 327 spe2vr2(ilci+1:nlci-1 ,1:jpjm1) = visc_dyn & 328 & * 0.5 * ( ztabramp(ilci+1:nlci-1,1:jpjm1 ) & 329 & + ztabramp(ilci+1:nlci-1,2:jpj ) ) 283 330 ENDIF 284 331 285 332 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 286 DO jj = 2, ispongearea 287 zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 288 ENDDO 289 spe1ur2(1:jpim1,2:ispongearea ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) & 290 & + zlocalviscsponge(2:jpi,2:ispongearea) ) 291 spe2vr2(: ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1) & 292 & + zlocalviscsponge(:,3:ispongearea) ) 333 spe1ur2(1:jpim1,2:ispongearea ) = visc_dyn & 334 & * 0.5 * ( ztabramp(1:jpim1,2:ispongearea ) & 335 & + ztabramp(2:jpi ,2:ispongearea ) ) 336 spe2vr2(: ,2:ispongearea-1) = visc_dyn & 337 & * 0.5 * ( ztabramp(: ,2:ispongearea-1) & 338 & + ztabramp(: ,3:ispongearea ) ) 293 339 ENDIF 294 340 295 341 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 296 DO jj = ilcj+1,nlcj-1 297 zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 298 ENDDO 299 spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) & 300 & + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) 301 spe2vr2(: ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2 ) & 302 & + zlocalviscsponge(:,ilcj+2:nlcj-1) ) 342 spe1ur2(1:jpim1,ilcj+1:nlcj-1 ) = visc_dyn & 343 & * 0.5 * ( ztabramp(1:jpim1,ilcj+1:nlcj-1 ) & 344 & + ztabramp(2:jpi ,ilcj+1:nlcj-1 ) ) 345 spe2vr2(: ,ilcj+1:nlcj-2 ) = visc_dyn & 346 & * 0.5 * ( ztabramp(: ,ilcj+1:nlcj-2 ) & 347 & + ztabramp(: ,ilcj+2:nlcj-1 ) ) 303 348 ENDIF 304 349 spongedoneU = .TRUE. … … 306 351 ENDIF 307 352 ! 308 CALL wrk_dealloc( jpi, jpj, zlocalviscsponge)353 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp ) 309 354 ! 310 355 #endif -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r3785 r4177 682 682 ! used to prevent the applied increments taking the temperature below the local freezing point 683 683 684 #if defined key_cice 685 fzptnz(:,:,:) = -1.8_wp 686 #else 687 DO jk = 1, jpk 688 DO jj = 1, jpj 689 DO ji = 1, jpk 690 fzptnz (ji,jj,jk) = ( -0.0575_wp + 1.710523e-3_wp * SQRT( tsn(ji,jj,jk,jp_sal) ) & 691 - 2.154996e-4_wp * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) & 692 - 7.53e-4_wp * fsdepw(ji,jj,jk) ! (pressure in dbar) 693 END DO 694 END DO 695 END DO 696 #endif 684 DO jk=1, jpkm1 685 fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 686 ENDDO 697 687 698 688 IF ( ln_asmiau ) THEN -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r3625 r4177 21 21 USE bdy_par ! (for lk_bdy) 22 22 USE timing ! preformance summary 23 USE lib_fortran 24 USE sbcrnf 23 25 24 26 IMPLICIT NONE … … 33 35 REAL(dp) :: surf_tot , vol_tot ! 34 36 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends 37 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends 35 38 REAL(dp) :: fact1 ! conversion factors 36 39 REAL(dp) :: fact21 , fact22 ! - - … … 38 41 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 39 42 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 43 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini 40 44 41 45 !! * Substitutions … … 67 71 INTEGER :: jk ! dummy loop indice 68 72 REAL(dp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 73 REAL(dp) :: zdiff_hc1 , zdiff_sc1 ! heat and salt content variations of ssh 69 74 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation 75 REAL(dp) :: zerr_hc1 , zerr_sc1 ! Non conservation due to free surface 70 76 REAL(dp) :: z1_rau0 ! local scalars 71 77 REAL(dp) :: zdeltat ! - - 72 78 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - - 73 79 REAL(dp) :: z_frc_trd_v ! - - 80 REAL(dp) :: z_wn_trd_t , z_wn_trd_s ! - - 81 REAL(dp) :: z_ssh_hc , z_ssh_sc ! - - 74 82 !!--------------------------------------------------------------------------- 75 83 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') … … 79 87 ! ------------------------- ! 80 88 z1_rau0 = 1.e0 / rau0 81 z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 82 z_frc_trd_t = SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 83 z_frc_trd_s = SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 89 z_frc_trd_v = z1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 90 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 91 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 92 ! Add runoff heat & salt input 93 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 94 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 84 95 ! Add penetrative solar radiation 85 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr (:,:) * surf(:,:) )96 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) 86 97 ! Add geothermal heat flux 87 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 88 IF( lk_mpp ) THEN 89 CALL mpp_sum( z_frc_trd_v ) 90 CALL mpp_sum( z_frc_trd_t ) 91 ENDIF 98 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) 99 IF( .NOT. lk_vvl ) THEN 100 z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 101 z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 102 ENDIF 103 92 104 frc_v = frc_v + z_frc_trd_v * rdt 93 105 frc_t = frc_t + z_frc_trd_t * rdt 94 106 frc_s = frc_s + z_frc_trd_s * rdt 107 ! ! Advection flux through fixed surface (z=0) 108 IF( .NOT. lk_vvl ) THEN 109 frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 110 frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 111 ENDIF 95 112 96 113 ! ----------------------- ! … … 100 117 zdiff_hc = 0.d0 101 118 zdiff_sc = 0.d0 119 102 120 ! volume variation (calculated with ssh) 103 zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) ) 121 zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 122 123 ! heat & salt content variation (associated with ssh) 124 IF( .NOT. lk_vvl ) THEN 125 z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 126 z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 127 ENDIF 128 104 129 DO jk = 1, jpkm1 105 106 zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk) &130 ! volume variation (calculated with scale factors) 131 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 107 132 & * ( fse3t_n(:,:,jk) & 108 133 & - e3t_ini(:,:,jk) ) ) 109 134 ! heat content variation 110 zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk) &135 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 111 136 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) & 112 137 & - hc_loc_ini(:,:,jk) ) ) 113 138 ! salt content variation 114 zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk) &139 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 115 140 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) & 116 141 & - sc_loc_ini(:,:,jk) ) ) 117 142 ENDDO 118 143 119 IF( lk_mpp ) THEN120 CALL mpp_sum( zdiff_hc )121 CALL mpp_sum( zdiff_sc )122 CALL mpp_sum( zdiff_v1 )123 CALL mpp_sum( zdiff_v2 )124 ENDIF125 126 144 ! Substract forcing from heat content, salt content and volume variations 127 145 zdiff_v1 = zdiff_v1 - frc_v 128 zdiff_v2 = zdiff_v2 - frc_v146 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v 129 147 zdiff_hc = zdiff_hc - frc_t 130 148 zdiff_sc = zdiff_sc - frc_s 149 IF( .NOT. lk_vvl ) THEN 150 zdiff_hc1 = zdiff_hc + z_ssh_hc 151 zdiff_sc1 = zdiff_sc + z_ssh_sc 152 zerr_hc1 = z_ssh_hc - frc_wn_t 153 zerr_sc1 = z_ssh_sc - frc_wn_s 154 ENDIF 131 155 132 156 ! ----------------------- ! … … 134 158 ! ----------------------- ! 135 159 zdeltat = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 136 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 137 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 138 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 139 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 160 IF( lk_vvl ) THEN 161 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 162 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 163 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 164 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 165 ELSE 166 WRITE(numhsb , 9030) kt , zdiff_hc1 / vol_tot , zdiff_hc1 * fact1 * zdeltat, & 167 & zdiff_sc1 / vol_tot , zdiff_sc1 * fact21 * zdeltat, zdiff_sc1 * fact22 * zdeltat, & 168 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 169 & zerr_hc1 / vol_tot , zerr_sc1 / vol_tot 170 ENDIF 140 171 141 172 IF ( kt == nitend ) CLOSE( numhsb ) … … 144 175 145 176 9020 FORMAT(I5,11D15.7) 177 9030 FORMAT(I5,10D15.7) 146 178 ! 147 179 END SUBROUTINE dia_hsb … … 179 211 180 212 IF( .NOT. ln_diahsb ) RETURN 213 IF( .NOT. lk_mpp_rep ) & 214 CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 215 & ' whereas the global sum to be precise must be done in double precision ',& 216 & ' please add key_mpp_rep') 181 217 182 218 ! ------------------- ! 183 219 ! 1 - Allocate memory ! 184 220 ! ------------------- ! 185 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 221 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 222 & ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), & 223 & e3t_ini(jpi,jpj,jpk) , & 224 & surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 186 225 IF( ierror > 0 ) THEN 187 226 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 188 ENDIF189 ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror )190 IF( ierror > 0 ) THEN191 CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' ) ; RETURN192 ENDIF193 ALLOCATE( e3t_ini(jpi,jpj,jpk) , STAT=ierror )194 IF( ierror > 0 ) THEN195 CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' ) ; RETURN196 ENDIF197 ALLOCATE( surf(jpi,jpj) , STAT=ierror )198 IF( ierror > 0 ) THEN199 CALL ctl_stop( 'dia_hsb: unable to allocate surf' ) ; RETURN200 ENDIF201 ALLOCATE( ssh_ini(jpi,jpj) , STAT=ierror )202 IF( ierror > 0 ) THEN203 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' ) ; RETURN204 227 ENDIF 205 228 … … 214 237 cl_name = 'heat_salt_volume_budgets.txt' ! name of output file 215 238 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 216 surf_tot = SUM( surf(:,:) ) ! total ocean surface area239 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 217 240 vol_tot = 0.d0 ! total ocean volume 218 241 DO jk = 1, jpkm1 219 vol_tot = vol_tot + SUM( surf(:,:) * tmask(:,:,jk) &220 & * fse3t_n(:,:,jk) )242 vol_tot = vol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) & 243 & * fse3t_n(:,:,jk) ) 221 244 END DO 222 IF( lk_mpp ) THEN223 CALL mpp_sum( vol_tot )224 CALL mpp_sum( surf_tot )225 ENDIF226 245 227 246 CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 228 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 229 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 230 ! 123456789012345678901234567890123456789012345 -> 45 231 & "| volume budget (ssh) ", & 232 ! 678901234567890123456789012345678901234567890 -> 45 233 & "| volume budget (e3t) " 234 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 235 & "| [m3] [mmm/s] [SV] ", & 236 & "| [m3] [mmm/s] [SV] " 237 247 IF( lk_vvl ) THEN 248 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 249 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 250 ! 123456789012345678901234567890123456789012345 -> 45 251 & "| volume budget (ssh) ", & 252 ! 678901234567890123456789012345678901234567890 -> 45 253 & "| volume budget (e3t) " 254 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 255 & "| [m3] [mmm/s] [SV] ", & 256 & "| [m3] [mmm/s] [SV] " 257 ELSE 258 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 259 WRITE( numhsb, 9011 ) "kt | heat content budget | salt content budget ", & 260 ! 123456789012345678901234567890123456789012345 -> 45 261 & "| volume budget (ssh) ", & 262 ! 678901234567890123456789012345678901234567890 -> 45 263 & "| Non conservation due to free surface " 264 WRITE( numhsb, 9011 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 265 & "| [m3] [mmm/s] [SV] ", & 266 & "| [heat - C] [salt - psu] " 267 ENDIF 238 268 ! --------------- ! 239 269 ! 3 - Conversions ! (factors will be multiplied by duration afterwards) … … 261 291 frc_t = 0.d0 ! heat content - - - - 262 292 frc_s = 0.d0 ! salt content - - - - 293 IF( .NOT. lk_vvl ) THEN 294 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * ssh_ini(:,:) ! initial heat content associated with ssh 295 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * ssh_ini(:,:) ! initial salt content associated with ssh 296 frc_wn_t = 0.d0 297 frc_wn_s = 0.d0 298 ENDIF 263 299 ! 264 300 9010 FORMAT(A80,A45,A45) 301 9011 FORMAT(A80,A45,A45) 265 302 ! 266 303 END SUBROUTINE dia_hsb_init -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r3632 r4177 108 108 ncsi1(2) = 97 ; ncsj1(2) = 107 109 109 ncsi2(2) = 103 ; ncsj2(2) = 111 110 ncsir(2,1) = 110 ; ncsjr(2,1) = 111 111 ! ! Black Sea 1 : west part of the Black Sea 112 ncsnr(3) = 1 ; ncstt(3) = 2 ! (ie west of the cyclic b.c.) 113 ncsi1(3) = 174 ; ncsj1(3) = 107 ! put in Med Sea 114 ncsi2(3) = 181 ; ncsj2(3) = 112 115 ncsir(3,1) = 171 ; ncsjr(3,1) = 106 116 ! ! Black Sea 2 : est part of the Black Sea 117 ncsnr(4) = 1 ; ncstt(4) = 2 ! (ie est of the cyclic b.c.) 118 ncsi1(4) = 2 ; ncsj1(4) = 107 ! put in Med Sea 119 ncsi2(4) = 6 ; ncsj2(4) = 112 120 ncsir(4,1) = 171 ; ncsjr(4,1) = 106 110 ncsir(2,1) = 110 ; ncsjr(2,1) = 111 111 ! ! Black Sea (crossed by the cyclic boundary condition) 112 ncsnr(3:4) = 4 ; ncstt(3:4) = 2 ! put in Med Sea (north of Aegean Sea) 113 ncsir(3:4,1) = 171; ncsjr(3:4,1) = 106 ! 114 ncsir(3:4,2) = 170; ncsjr(3:4,2) = 106 115 ncsir(3:4,3) = 171; ncsjr(3:4,3) = 105 116 ncsir(3:4,4) = 170; ncsjr(3:4,4) = 105 117 ncsi1(3) = 174 ; ncsj1(3) = 107 ! 1 : west part of the Black Sea 118 ncsi2(3) = 181 ; ncsj2(3) = 112 ! (ie west of the cyclic b.c.) 119 ncsi1(4) = 2 ; ncsj1(4) = 107 ! 2 : east part of the Black Sea 120 ncsi2(4) = 6 ; ncsj2(4) = 112 ! (ie east of the cyclic b.c.) 121 122 123 121 124 ! ! ======================= 122 125 CASE ( 4 ) ! ORCA_R4 configuration … … 372 375 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array) 373 376 ! 374 INTEGER :: jc, jn ! dummy loop indices 375 INTEGER :: ii, ij ! temporary integer 377 INTEGER :: jc, jn, ji, jj ! dummy loop indices 376 378 !!---------------------------------------------------------------------- 377 379 ! … … 379 381 IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows 380 382 DO jn = 1, 4 381 ii = mi0( ncsir(jc,jn) ) 382 ij = mj0( ncsjr(jc,jn) ) 383 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0_wp ) 383 DO jj = mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) ) 384 DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) ) 385 p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp ) 386 END DO 387 END DO 384 388 END DO 385 389 ENDIF -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r3851 r4177 238 238 nday_year = 1 239 239 nsec_year = ndt05 240 IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN ! test integer 4 max value 241 CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ', & 242 & 'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', & 243 & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' ) 244 ENDIF 240 245 nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1) 241 246 IF( nleapy == 1 ) CALL day_mth -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4175 r4177 1102 1102 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 1103 1103 REAL(wp) :: zrmax, ztaper ! temporary scalars 1104 REAL(wp) :: zrfact ! temporary scalars 1105 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 1106 1107 ! 1108 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, zri, zrj, zhbat 1104 ! 1105 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1109 1106 1110 1107 NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & … … 1114 1111 IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1115 1112 ! 1116 CALL wrk_alloc( jpi, jpj, ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 1117 CALL wrk_alloc( jpi, jpj, zenv, zri, zrj, zhbat ) 1118 ! 1113 CALL wrk_alloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1114 ! 1119 1115 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1120 1116 READ ( numnam, namzgr_sco ) … … 1163 1159 ! ! ============================= 1164 1160 ! use r-value to create hybrid coordinates 1165 ! DO jj = 1, jpj 1166 ! DO ji = 1, jpi 1167 ! zenv(ji,jj) = MAX( bathy(ji,jj), 0._wp ) 1168 ! END DO 1169 ! END DO 1170 ! CALL lbc_lnk( zenv, 'T', 1._wp ) 1171 zenv(:,:) = bathy(:,:) 1161 DO jj = 1, jpj 1162 DO ji = 1, jpi 1163 zenv(ji,jj) = MAX( bathy(ji,jj), rn_sbot_min ) 1164 END DO 1165 END DO 1172 1166 ! 1173 1167 ! Smooth the bathymetry (if required) … … 1177 1171 jl = 0 1178 1172 zrmax = 1._wp 1179 ! 1180 ! set scaling factor used in reducing vertical gradients 1181 zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax ) 1182 ! 1183 ! initialise temporary evelope depth arrays 1184 ztmpi1(:,:) = zenv(:,:) 1185 ztmpi2(:,:) = zenv(:,:) 1186 ztmpj1(:,:) = zenv(:,:) 1187 ztmpj2(:,:) = zenv(:,:) 1188 ! 1189 ! initialise temporary r-value arrays 1190 zri(:,:) = 1._wp 1191 zrj(:,:) = 1._wp 1192 ! ! ================ ! 1193 DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) ! Iterative loop ! 1194 ! ! ================ ! 1173 ! ! ================ ! 1174 DO WHILE( jl <= 10000 .AND. zrmax > rn_rmax ) ! Iterative loop ! 1175 ! ! ================ ! 1195 1176 jl = jl + 1 1196 1177 zrmax = 0._wp 1197 ! we set zrmax from previous r-values (zri abd zrj) first 1198 ! if set after current r-value calculation (as previously) 1199 ! we could exit DO WHILE prematurely before checking r-value 1200 ! of current zenv 1201 DO jj = 1, nlcj 1202 DO ji = 1, nlci 1203 zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) ) 1204 END DO 1205 END DO 1206 zri(:,:) = 0._wp 1207 zrj(:,:) = 0._wp 1178 zmsk(:,:) = 0._wp 1208 1179 DO jj = 1, nlcj 1209 1180 DO ji = 1, nlci 1210 1181 iip1 = MIN( ji+1, nlci ) ! force zri = 0 on last line (ji=ncli+1 to jpi) 1211 1182 ijp1 = MIN( jj+1, nlcj ) ! force zrj = 0 on last raw (jj=nclj+1 to jpj) 1212 IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN 1213 zri(ji,jj) = ( zenv(iip1,jj ) - zenv(ji,jj) ) / ( zenv(iip1,jj ) + zenv(ji,jj) ) 1214 END IF 1215 IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN 1216 zrj(ji,jj) = ( zenv(ji ,ijp1) - zenv(ji,jj) ) / ( zenv(ji ,ijp1) + zenv(ji,jj) ) 1217 END IF 1218 IF( zri(ji,jj) > rn_rmax ) ztmpi1(ji ,jj ) = zenv(iip1,jj ) * zrfact 1219 IF( zri(ji,jj) < -rn_rmax ) ztmpi2(iip1,jj ) = zenv(ji ,jj ) * zrfact 1220 IF( zrj(ji,jj) > rn_rmax ) ztmpj1(ji ,jj ) = zenv(ji ,ijp1) * zrfact 1221 IF( zrj(ji,jj) < -rn_rmax ) ztmpj2(ji ,ijp1) = zenv(ji ,jj ) * zrfact 1183 zri(ji,jj) = ABS( zenv(iip1,jj ) - zenv(ji,jj) ) / ( zenv(iip1,jj ) + zenv(ji,jj) ) 1184 zrj(ji,jj) = ABS( zenv(ji ,ijp1) - zenv(ji,jj) ) / ( zenv(ji ,ijp1) + zenv(ji,jj) ) 1185 zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) ) 1186 IF( zri(ji,jj) > rn_rmax ) zmsk(ji ,jj ) = 1._wp 1187 IF( zri(ji,jj) > rn_rmax ) zmsk(iip1,jj ) = 1._wp 1188 IF( zrj(ji,jj) > rn_rmax ) zmsk(ji ,jj ) = 1._wp 1189 IF( zrj(ji,jj) > rn_rmax ) zmsk(ji ,ijp1) = 1._wp 1222 1190 END DO 1223 1191 END DO 1224 1192 IF( lk_mpp ) CALL mpp_max( zrmax ) ! max over the global domain 1193 ! lateral boundary condition on zmsk: keep 1 along closed boundary (use of MAX) 1194 ztmp(:,:) = zmsk(:,:) ; CALL lbc_lnk( zmsk, 'T', 1._wp ) 1195 DO jj = 1, nlcj 1196 DO ji = 1, nlci 1197 zmsk(ji,jj) = MAX( zmsk(ji,jj), ztmp(ji,jj) ) 1198 END DO 1199 END DO 1225 1200 ! 1226 IF(lwp)WRITE(numout,*) 'zgr_sco : iter= ',jl, ' rmax= ', zrmax 1201 IF(lwp)WRITE(numout,*) 'zgr_sco : iter= ',jl, ' rmax= ', zrmax, ' nb of pt= ', INT( SUM(zmsk(:,:) ) ) 1227 1202 ! 1228 1203 DO jj = 1, nlcj 1229 1204 DO ji = 1, nlci 1230 zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) ) 1205 iip1 = MIN( ji+1, nlci ) ! last line (ji=nlci) 1206 ijp1 = MIN( jj+1, nlcj ) ! last raw (jj=nlcj) 1207 iim1 = MAX( ji-1, 1 ) ! first line (ji=nlci) 1208 ijm1 = MAX( jj-1, 1 ) ! first raw (jj=nlcj) 1209 IF( zmsk(ji,jj) == 1._wp ) THEN 1210 ztmp(ji,jj) = ( & 1211 & zenv(iim1,ijp1)*zmsk(iim1,ijp1) + zenv(ji,ijp1)*zmsk(ji,ijp1) + zenv(iip1,ijp1)*zmsk(iip1,ijp1) & 1212 & + zenv(iim1,jj )*zmsk(iim1,jj ) + zenv(ji,jj )* 2._wp + zenv(iip1,jj )*zmsk(iip1,jj ) & 1213 & + zenv(iim1,ijm1)*zmsk(iim1,ijm1) + zenv(ji,ijm1)*zmsk(ji,ijm1) + zenv(iip1,ijm1)*zmsk(iip1,ijm1) & 1214 & ) / ( & 1215 & zmsk(iim1,ijp1) + zmsk(ji,ijp1) + zmsk(iip1,ijp1) & 1216 & + zmsk(iim1,jj ) + 2._wp + zmsk(iip1,jj ) & 1217 & + zmsk(iim1,ijm1) + zmsk(ji,ijm1) + zmsk(iip1,ijm1) & 1218 & ) 1219 ENDIF 1231 1220 END DO 1232 1221 END DO 1233 1222 ! 1234 CALL lbc_lnk( zenv, 'T', 1._wp ) 1223 DO jj = 1, nlcj 1224 DO ji = 1, nlci 1225 IF( zmsk(ji,jj) == 1._wp ) zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) ) 1226 END DO 1227 END DO 1228 ! 1229 ! Apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 1230 ztmp(:,:) = zenv(:,:) ; CALL lbc_lnk( zenv, 'T', 1._wp ) 1231 DO jj = 1, nlcj 1232 DO ji = 1, nlci 1233 IF( zenv(ji,jj) == 0._wp ) zenv(ji,jj) = ztmp(ji,jj) 1234 END DO 1235 END DO 1235 1236 ! ! ================ ! 1236 1237 END DO ! End loop ! 1237 1238 ! ! ================ ! 1238 1239 ! 1239 ! DO jj = 1, jpj 1240 ! DO ji = 1, jpi 1241 ! zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale values 1242 ! END DO 1243 ! END DO 1240 ! Fill ghost rows with appropriate values to avoid undefined e3 values with some mpp decompositions 1241 DO ji = nlci+1, jpi 1242 zenv(ji,1:nlcj) = zenv(nlci,1:nlcj) 1243 END DO 1244 ! 1245 DO jj = nlcj+1, jpj 1246 zenv(:,jj) = zenv(:,nlcj) 1247 END DO 1244 1248 ! 1245 1249 ! Envelope bathymetry saved in hbatt 1246 1250 hbatt(:,:) = zenv(:,:) 1247 1248 1251 IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 1249 1252 CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 1250 1253 DO jj = 1, jpj 1251 1254 DO ji = 1, jpi 1252 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )1255 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp ) 1253 1256 hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 1254 1257 END DO … … 1365 1368 fsde3w(:,:,:) = gdep3w(:,:,:) 1366 1369 ! 1367 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1. 01368 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1. 01369 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1. 01370 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1. 01371 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1. 01372 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1. 01373 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1. 01370 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1._wp 1371 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1._wp 1372 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1._wp 1373 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1._wp 1374 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1._wp 1375 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1._wp 1376 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1._wp 1374 1377 1375 1378 #if defined key_agrif … … 1519 1522 END DO 1520 1523 ! 1521 CALL wrk_dealloc( jpi, jpj, zenv, ztmpi1, ztmpi2, ztmpj1, ztmpj2, zri, zrj, zhbat ) ! 1524 CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1525 ! 1522 1526 IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') 1523 1527 ! … … 1748 1752 ENDDO 1749 1753 ! 1750 CALL lbc_lnk(e3t ,'T',1.) ; CALL lbc_lnk(e3u ,'T',1.)1751 CALL lbc_lnk(e3v ,'T',1.) ; CALL lbc_lnk(e3f ,'T',1.)1752 CALL lbc_lnk(e3w ,'T',1.)1753 CALL lbc_lnk(e3uw,'T',1.) ; CALL lbc_lnk(e3vw,'T',1.)1754 !1755 1754 ! ! ============= 1756 1755 … … 1849 1848 !!---------------------------------------------------------------------- 1850 1849 ! 1851 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1 ) + rn_thetb ) ) &1850 pf = ( TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1,wp) + rn_thetb ) ) & 1852 1851 & - TANH( rn_thetb * rn_theta ) ) & 1853 1852 & * ( COSH( rn_theta ) & … … 1875 1874 ! 1876 1875 IF ( rn_theta == 0 ) then ! uniform sigma 1877 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )1876 pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1,wp ) 1878 1877 ELSE ! stretched sigma 1879 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1 )) ) ) / SINH( rn_theta ) &1880 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1 )) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) &1878 pf1 = ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1,wp)) ) ) / SINH( rn_theta ) & 1879 & + pbb * ( (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1,wp)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta ) ) & 1881 1880 & / ( 2._wp * TANH( 0.5_wp * rn_theta ) ) ) 1882 1881 ENDIF -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r3765 r4177 109 109 INTEGER :: ji, jj, jk ! dummy loop indices 110 110 REAL(wp) :: z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv ! local scalars 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zub, zvb112 111 !!---------------------------------------------------------------------- 113 112 ! 114 113 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_flt') 115 114 ! 116 CALL wrk_alloc( jpi,jpj,jpk, zub, zvb )117 115 ! 118 116 IF( kt == nit000 ) THEN … … 213 211 DO jk = 1, jpkm1 214 212 DO ji = 1, jpij 215 spgu(ji,1) = spgu(ji,1) + fse3u (ji,1,jk) * ua(ji,1,jk)216 spgv(ji,1) = spgv(ji,1) + fse3v (ji,1,jk) * va(ji,1,jk)213 spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 214 spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 217 215 END DO 218 216 END DO … … 221 219 DO jj = 2, jpjm1 222 220 DO ji = 2, jpim1 223 spgu(ji,jj) = spgu(ji,jj) + fse3u (ji,jj,jk) * ua(ji,jj,jk)224 spgv(ji,jj) = spgv(ji,jj) + fse3v (ji,jj,jk) * va(ji,jj,jk)221 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 222 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 225 223 END DO 226 224 END DO … … 360 358 IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 361 359 ! 362 CALL wrk_dealloc( jpi,jpj,jpk, zub, zvb )363 360 ! 364 361 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_flt') -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4174 r4177 2181 2181 !!gm Remark : this is very time consumming!!! 2182 2182 ! ! ------------------------ ! 2183 IF( ijpt0 > ijpt1 .OR. iipt0 > iipt1) THEN2183 IF(((nbondi .ne. 0) .AND. (ktype .eq. 2)) .OR. ((nbondj .ne. 0) .AND. (ktype .eq. 1))) THEN 2184 2184 ! there is nothing to be migrated 2185 lmigr = .FALSE.2185 lmigr = .TRUE. 2186 2186 ELSE 2187 lmigr = . TRUE.2187 lmigr = .FALSE. 2188 2188 ENDIF 2189 2189 -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r2715 r4177 187 187 & gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr ) 188 188 IF(lk_mpp) CALL mpp_sum( ierr ) 189 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )189 IF( ierr /= 0 ) CALL ctl_stop('angle: unable to allocate arrays' ) 190 190 191 191 ! ============================= ! … … 361 361 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 362 362 IF( lk_mpp ) CALL mpp_sum( ierr ) 363 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )363 IF( ierr /= 0 ) CALL ctl_stop('geo2oce: unable to allocate arrays' ) 364 364 ENDIF 365 365 … … 438 438 !!---------------------------------------------------------------------- 439 439 440 IF( ALLOCATED( gsinlon ) ) THEN440 IF( .NOT. ALLOCATED( gsinlon ) ) THEN 441 441 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 442 442 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 443 443 IF( lk_mpp ) CALL mpp_sum( ierr ) 444 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )444 IF( ierr /= 0 ) CALL ctl_stop('oce2geo: unable to allocate arrays' ) 445 445 ENDIF 446 446 -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3914 r4177 388 388 ! 389 389 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 390 srcv(jpr_it z1:jpr_itz2)%laction = .FALSE. ! ice components not received (itx1 and ity1 used later)390 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received 391 391 srcv(jpr_itx1)%clgrid = 'U' ! ocean stress used after its transformation 392 392 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. … … 407 407 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 408 408 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 409 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 409 CASE( 'conservative' ) 410 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 411 IF ( k_ice <= 1 ) srcv(jpr_ivep)%laction = .FALSE. 410 412 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 411 413 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 465 467 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 466 468 ! ! ------------------------- ! 467 ! ! Ice Qsr penetration !468 ! ! ------------------------- !469 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer470 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )471 ! Coupled case: since cloud cover is not received from atmosphere472 ! ===> defined as constant value -> definition done in sbc_cpl_init473 fr1_i0(:,:) = 0.18474 fr2_i0(:,:) = 0.82475 ! ! ------------------------- !476 469 ! ! 10m wind module ! 477 470 ! ! ------------------------- ! … … 508 501 ! Allocate taum part of frcv which is used even when not received as coupling field 509 502 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 503 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 504 IF( k_ice /= 0 ) THEN 505 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) ) 506 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) ) 507 END IF 510 508 511 509 ! ================================ ! … … 1329 1327 END SELECT 1330 1328 1329 ! Ice Qsr penetration used (only?)in lim2 or lim3 1330 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 1331 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 1332 ! Coupled case: since cloud cover is not received from atmosphere 1333 ! ===> defined as constant value -> definition done in sbc_cpl_init 1334 fr1_i0(:,:) = 0.18 1335 fr2_i0(:,:) = 0.82 1336 1337 1331 1338 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1332 1339 ! -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3905 r4177 221 221 ENDIF 222 222 ! 223 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 224 ! 223 225 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 224 226 ! -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r3625 r4177 675 675 676 676 677 FUNCTION tfreez( psal ) RESULT( ptf )677 FUNCTION tfreez( psal, pdep ) RESULT( ptf ) 678 678 !!---------------------------------------------------------------------- 679 679 !! *** ROUTINE eos_init *** … … 688 688 !!---------------------------------------------------------------------- 689 689 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 690 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [decibars] 690 691 ! Leave result array automatic rather than making explicitly allocated 691 692 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] … … 694 695 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 695 696 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 697 IF ( PRESENT( pdep ) ) THEN 698 ptf(:,:) = ptf(:,:) - 7.53e-4_wp * pdep(:,:) 699 ENDIF 696 700 ! 697 701 END FUNCTION tfreez -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r3851 r4177 246 246 nday_year = 1 247 247 nsec_year = ndt05 248 IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN ! test integer 4 max value 249 CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ', & 250 & 'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', & 251 & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' ) 252 ENDIF 248 253 nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1) 249 254 IF( nleapy == 1 ) CALL day_mth -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r3905 r4177 82 82 IF( nn_timing == 1 ) CALL timing_start('p4z_sed') 83 83 ! 84 IF( kt == nit 000 .AND. jnt == 1 ) THEN84 IF( kt == nittrc000 .AND. jnt == 1 ) THEN 85 85 ryyss = nyear_len(1) * rday ! number of seconds per year and per month 86 86 rmtss = ryyss / raamo -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r4175 r4177 76 76 ENDIF 77 77 ! 78 IF( ln_rsttr .AND. kt == nittrc000 ) CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields 78 IF( kt == nittrc000 ) THEN 79 ! 80 CALL p4z_che ! initialize the chemical constants 81 ! 82 IF( .NOT. ln_rsttr ) THEN ; CALL p4z_ph_ini ! set PH at kt=nit000 83 ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields 84 ENDIF 85 ! 86 ENDIF 87 79 88 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 80 89 ! … … 238 247 END SUBROUTINE p4z_sms_init 239 248 249 SUBROUTINE p4z_ph_ini 250 !!--------------------------------------------------------------------- 251 !! *** ROUTINE p4z_ini_ph *** 252 !! 253 !! ** Purpose : Initialization of chemical variables of the carbon cycle 254 !!--------------------------------------------------------------------- 255 INTEGER :: ji, jj, jk 256 REAL(wp) :: zcaralk, zbicarb, zco3 257 REAL(wp) :: ztmas, ztmas1 258 !!--------------------------------------------------------------------- 259 260 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 261 ! -------------------------------------------------------- 262 DO jk = 1, jpk 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 ztmas = tmask(ji,jj,jk) 266 ztmas1 = 1. - tmask(ji,jj,jk) 267 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 268 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 269 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 270 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 271 END DO 272 END DO 273 END DO 274 ! 275 END SUBROUTINE p4z_ph_ini 276 240 277 SUBROUTINE p4z_rst( kt, cdrw ) 241 278 !!--------------------------------------------------------------------- … … 266 303 ELSE 267 304 ! hi(:,:,:) = 1.e-9 268 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 269 ! -------------------------------------------------------- 270 DO jk = 1, jpk 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 ztmas = tmask(ji,jj,jk) 274 ztmas1 = 1. - tmask(ji,jj,jk) 275 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 276 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 277 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 278 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 279 END DO 280 END DO 281 END DO 305 CALL p4z_ph_ini 282 306 ENDIF 283 307 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r3757 r4177 122 122 rdenita = 3._wp / 5._wp 123 123 o2ut = 131._wp / 122._wp 124 125 CALL p4z_che ! initialize the chemical constants126 124 127 125 ! Initialization of tracer concentration in case of no restart … … 162 160 xksi(:,:) = 2.e-6 163 161 xksimax(:,:) = xksi(:,:) 164 165 ! Initialization of chemical variables of the carbon cycle 166 ! -------------------------------------------------------- 167 DO jk = 1, jpk 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 ztmas = tmask(ji,jj,jk) 171 ztmas1 = 1. - tmask(ji,jj,jk) 172 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 173 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 174 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 175 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 176 END DO 177 END DO 178 END DO 179 ! 162 ! 180 163 END IF 181 164 -
branches/2013/dev_CMCC_2013/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
r3925 r4177 40 40 # :: 41 41 # 42 # $ ./Fcheck_archfile.sh ARCHFILE C OMPILER42 # $ ./Fcheck_archfile.sh ARCHFILE CPPFILE COMPILER 43 43 # 44 44 # … … 94 94 else 95 95 if [ -f ${COMPIL_DIR}/$1 ]; then 96 # has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}? 97 mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" ) 98 if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then 99 echo $mycpp > ${COMPIL_DIR}/cpp.history 100 cpeval ${myarch} ${COMPIL_DIR}/$1 96 if [ "$2" != "nocpp" ] 97 then 98 # has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}? 99 mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" ) 100 if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then 101 echo $mycpp > ${COMPIL_DIR}/cpp.history 102 cpeval ${myarch} ${COMPIL_DIR}/$1 103 fi 104 # has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}? 105 mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print ) 106 [ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1 101 107 fi 102 # has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}?103 mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print )104 [ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1105 108 # has myarch file been updated since we copied it in ${COMPIL_DIR}? 106 109 myarchdir=$( dirname ${myarch} ) … … 134 137 if [ "$myarch" == "$( cat ${COMPIL_DIR}/arch.history )" ]; then 135 138 if [ -f ${COMPIL_DIR}/$1 ]; then 136 # has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}? 137 mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" ) 138 if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then 139 echo $mycpp > ${COMPIL_DIR}/cpp.history 140 cpeval ${myarch} ${COMPIL_DIR}/$1 139 if [ "$2" != "nocpp" ] 140 then 141 # has the cpp keys file been changed since we copied the arch file in ${COMPIL_DIR}? 142 mycpp=$( ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" ) 143 if [ "$mycpp" != "$( cat ${COMPIL_DIR}/cpp.history )" ]; then 144 echo $mycpp > ${COMPIL_DIR}/cpp.history 145 cpeval ${myarch} ${COMPIL_DIR}/$1 146 fi 147 # has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}? 148 mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print ) 149 [ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1 141 150 fi 142 # has the cpp keys file been updated since we copied the arch file in ${COMPIL_DIR}?143 mycpp=$( find -L ${COMPIL_DIR} -cnewer ${COMPIL_DIR}/$1 -name $2 -print )144 [ ${#mycpp} -ne 0 ] && cpeval ${myarch} ${COMPIL_DIR}/$1145 151 # has myarch file been updated since we copied it in ${COMPIL_DIR}? 146 152 myarch=$( find -L ${MAIN_DIR}/ARCH -cnewer ${COMPIL_DIR}/$1 -name arch-${3}.fcm -print ) … … 150 156 fi 151 157 else 152 ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" > ${COMPIL_DIR}/cpp.history 158 if [ "$2" != "nocpp" ] 159 then 160 ls -l ${COMPIL_DIR}/$2 | sed -e "s/.* -> //" > ${COMPIL_DIR}/cpp.history 161 fi 153 162 echo ${myarch} > ${COMPIL_DIR}/arch.history 154 163 cpeval ${myarch} ${COMPIL_DIR}/$1 … … 157 166 158 167 #- do we need xios library? 159 use_iom=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_iomput ) 168 if [ "$2" != "nocpp" ] 169 then 170 use_iom=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_iomput ) 171 else 172 use_iom=0 173 fi 160 174 have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" ) 161 175 if [[ ( $use_iom -eq 0 ) && ( $have_lxios -ge 1 ) ]] … … 166 180 167 181 #- do we need oasis libraries? 168 use_oasis=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_oasis3 ) 182 if [ "$2" != "nocpp" ] 183 then 184 use_oasis=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_oasis3 ) 185 else 186 use_oasis=0 187 fi 169 188 for liboa in psmile.MPI1 mct mpeu scrip mpp_io 170 189 do -
branches/2013/dev_CMCC_2013/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh
r4175 r4177 59 59 #------------------------------------------------ 60 60 # 61 external=$( grep -c "<field_definition .*src=" $xmlfile )61 external=$( grep -c "<field_definition *\([^ ].* \)*src=" $xmlfile ) 62 62 if [ $external -eq 1 ] 63 63 then 64 xmlfield_def=$( grep "<field_definition .*src=" $xmlfile | sed -e 's/.*src="\([^"]*\)".*/\1/' )64 xmlfield_def=$( grep "<field_definition *\([^ ].* \)*src=" $xmlfile | sed -e 's/.*src="\([^"]*\)".*/\1/' ) 65 65 xmlfield_def=$( dirname $xmlfile )/$xmlfield_def 66 66 else 67 67 xmlfield_def=$xmlfile 68 68 fi 69 [ $inxml -eq 1 ] && grep "< *field *id *=" $xmlfield_def69 [ $inxml -eq 1 ] && grep "< *field *\([^ ].* \)*id *=" $xmlfield_def 70 70 [ $insrc -eq 1 ] && find $srcdir -name "*.[Ffh]90" -exec grep -iH "^[^\!]*call *iom_put *(" {} \; 71 71 [ $(( $insrc + $inxml )) -ge 1 ] && exit … … 91 91 # list of variables defined in the xml file 92 92 # 93 varlistxml=$( grep "< *field .* id *=" $xmlfield_def | sed -e "s/^.*< *field.*id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )93 varlistxml=$( grep "< *field *\([^ ].* \)*id *=" $xmlfield_def | sed -e "s/^.*< *field .*id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d ) 94 94 # 95 95 # list of variables to be outputed in the xml file 96 96 # 97 varlistout=$( grep "< *field .* field_ref *=" $xmlfile | sed -e "s/^.*< *field.*field_ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )97 varlistout=$( grep "< *field *\([^ ].* \)*field_ref *=" $xmlfile | sed -e "s/^.*< *field .*field_ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d ) 98 98 # 99 99 echo "--------------------------------------------------" -
branches/2013/dev_CMCC_2013/NEMOGCM/TOOLS/maketools
r3294 r4177 146 146 147 147 #- When used for the first time, choose a compiler --- 148 . ${COMPIL_DIR}/Fcheck_archfile.sh arch_tools.fcm ${CMP_NAM} || exit148 . ${COMPIL_DIR}/Fcheck_archfile.sh arch_tools.fcm nocpp ${CMP_NAM} || exit 149 149 150 150 #- Choose a default tool if needed ---
Note: See TracChangeset
for help on using the changeset viewer.
