Changeset 3168
- Timestamp:
- 2011-11-22T10:48:38+01:00 (12 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 1 deleted
- 9 edited
-
diaar5.F90 (modified) (7 diffs)
-
diadct.F90 (modified) (18 diffs)
-
diafwb.F90 (modified) (3 diffs)
-
diaharm.F90 (modified) (7 diffs)
-
diahsb.F90 (modified) (3 diffs)
-
diahth.F90 (modified) (4 diffs)
-
diaptr.F90 (modified) (17 diffs)
-
diawri.F90 (modified) (9 diffs)
-
diawri_dimg.h90 (modified) (2 diffs)
-
surdetermine.F90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r2977 r3168 19 19 USE lib_mpp ! distribued memory computing library 20 20 USE iom ! I/O manager library 21 USE timing ! preformance summary 22 USE wrk_nemo_2 ! working arrays 21 23 22 24 IMPLICIT NONE … … 65 67 !! ** Purpose : compute and output some AR5 diagnostics 66 68 !!---------------------------------------------------------------------- 67 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released68 USE wrk_nemo, ONLY: zarea_ssh => wrk_2d_1 , zbotpres => wrk_2d_2 ! 2D workspace69 USE wrk_nemo, ONLY: zrhd => wrk_3d_1 , zrhop => wrk_3d_2 ! 3D -70 USE wrk_nemo, ONLY: ztsn => wrk_4d_1 ! 4D -71 69 ! 72 70 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 74 72 INTEGER :: ji, jj, jk ! dummy loop arguments 75 73 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 74 ! 75 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 77 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 76 78 !!-------------------------------------------------------------------- 77 78 IF( wrk_in_use(2, 1,2) .OR. & 79 wrk_in_use(3, 1,2) .OR. & 80 wrk_in_use(4, 1) ) THEN 81 CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') ; RETURN 82 ENDIF 79 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 80 81 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres ) 82 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 83 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 83 84 84 85 CALL iom_put( 'cellthc', fse3t(:,:,:) ) … … 160 161 CALL iom_put( 'saltot' , zsal ) 161 162 ! 162 IF( wrk_not_released(2, 1,2) .OR. & 163 wrk_not_released(3, 1,2) .OR. & 164 wrk_not_released(4, 1) ) CALL ctl_stop('dia_ar5: failed to release workspace arrays') 163 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 164 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 165 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 166 ! 167 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') 165 168 ! 166 169 END SUBROUTINE dia_ar5 … … 173 176 !! ** Purpose : initialization for AR5 diagnostic computation 174 177 !!---------------------------------------------------------------------- 175 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released176 USE wrk_nemo, ONLY: wrk_4d_1 ! 4D workspace177 !178 178 INTEGER :: inum 179 179 INTEGER :: ik … … 183 183 !!---------------------------------------------------------------------- 184 184 ! 185 IF(wrk_in_use(4, 1) ) THEN 186 CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') ; RETURN 187 ENDIF 188 zsaldta => wrk_4d_1(:,:,:,1:2) 189 185 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 186 ! 187 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 190 188 ! ! allocate dia_ar5 arrays 191 189 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 221 219 ENDIF 222 220 ! 223 IF( wrk_not_released(4, 1) ) CALL ctl_stop('dia_ar5_init: failed to release workspace array') 221 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 222 ! 223 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') 224 224 ! 225 225 END SUBROUTINE dia_ar5_init -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r3106 r3168 42 42 #endif 43 43 USE domvvl 44 USE timing ! preformance summary 45 USE wrk_nemo_2 ! working arrays 44 46 45 47 IMPLICIT NONE … … 114 116 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 115 117 118 IF( nn_timing == 1 ) CALL timing_start('dia_dct_init') 119 116 120 !read namelist 117 121 REWIND( numnam ) … … 147 151 ENDIF 148 152 149 153 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init') 154 ! 150 155 END SUBROUTINE dia_dct_init 151 156 … … 161 166 162 167 !! * Local variables 163 INTEGER :: jsec, &!loop on sections 164 iost !error for opening fileout 165 LOGICAL :: lldebug =.FALSE. !debug a section 166 CHARACTER(len=160) :: clfileout !fileout name 168 INTEGER :: jsec, &! loop on sections 169 iost, &! error for opening fileout 170 itotal ! nb_sec_max*nb_type_class*nb_class_max 171 LOGICAL :: lldebug =.FALSE. ! debug a section 172 CHARACTER(len=160) :: clfileout ! fileout name 167 173 168 174 169 INTEGER , DIMENSION(1) :: ish! tmp array for mpp_sum170 INTEGER , DIMENSION(3) :: ish2! "171 REAL(wp), DIMENSION(nb_sec_max*nb_type_class*nb_class_max):: zwork ! "172 REAL(wp), DIMENSION(nb_sec_max,nb_type_class,nb_class_max):: zsum ! "175 INTEGER , DIMENSION(1) :: ish ! tmp array for mpp_sum 176 INTEGER , DIMENSION(3) :: ish2 ! " 177 REAL(wp), POINTER, DIMENSION(:) :: zwork ! " 178 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! " 173 179 174 180 !!--------------------------------------------------------------------- 175 181 IF( nn_timing == 1 ) CALL timing_start('dia_dct') 182 183 IF( lk_mpp )THEN 184 itotal = nb_sec_max*nb_type_class*nb_class_max 185 CALL wrk_alloc( itotal , zwork ) 186 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 187 ENDIF 188 176 189 IF( lwp .AND. kt==nit000+nn_dct-1 ) THEN 177 190 WRITE(numout,*) " " … … 189 202 !debug this section computing ? 190 203 lldebug=.FALSE. 191 ! IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 192 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 ) lldebug=.TRUE. 204 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 193 205 194 206 !Compute transport through section … … 226 238 ENDIF 227 239 240 IF( lk_mpp )THEN 241 itotal = nb_sec_max*nb_type_class*nb_class_max 242 CALL wrk_alloc( itotal , zwork ) 243 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 244 ENDIF 245 246 IF( nn_timing == 1 ) CALL timing_stop('dia_dct') 247 ! 228 248 END SUBROUTINE dia_dct 229 249 … … 250 270 TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates 251 271 !read in the file 252 INTEGER, DIMENSION(nb_point_max) ::directemp!contains listpoints directions272 INTEGER, POINTER, DIMENSION(:) :: directemp !contains listpoints directions 253 273 !read in the files 254 274 LOGICAL :: llbon ,&!local logical 255 275 lldebug !debug the section 256 276 !!------------------------------------------------------------------------------------- 277 CALL wrk_alloc( nb_point_max, directemp ) 257 278 258 279 !open input file … … 381 402 ENDIF 382 403 404 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 405 WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 406 DO jpt = 1,iptloc 407 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 408 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 409 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo 410 ENDDO 411 ENDIF 412 383 413 !remove redundant points between processors 384 414 !------------------------------------------ … … 390 420 CALL removepoints(secs(jsec),'J','bot_list',lldebug) 391 421 ENDIF 422 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 423 WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 424 DO jpt = 1,secs(jsec)%nb_point 425 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 426 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 427 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo 428 ENDDO 429 ENDIF 392 430 393 431 !debug … … 395 433 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN 396 434 WRITE(numout,*)" List of points after removepoints:" 435 iptloc = secs(jsec)%nb_point 397 436 DO jpt = 1,iptloc 398 437 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 … … 411 450 nb_sec = jsec-1 !number of section read in the file 412 451 452 CALL wrk_dealloc( nb_point_max, directemp ) 453 ! 413 454 END SUBROUTINE readsec 414 455 … … 436 477 ! isgn=-1 : scan listpoint from end to start 437 478 istart,iend !first and last points selected in listpoint 438 INTEGER :: jpoint =0!loop on list points439 INTEGER, DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction440 INTEGER, DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint479 INTEGER :: jpoint !loop on list points 480 INTEGER, POINTER, DIMENSION(:) :: idirec !contains temporary sec%direction 481 INTEGER, POINTER, DIMENSION(:,:) :: icoord !contains temporary sec%listpoint 441 482 !---------------------------------------------------------------------------- 483 CALL wrk_alloc( nb_point_max, idirec ) 484 CALL wrk_alloc( 2, nb_point_max, icoord ) 485 442 486 IF( ld_debug )WRITE(numout,*)' -------------------------' 443 487 IF( ld_debug )WRITE(numout,*)' removepoints in listpoint' … … 467 511 sec%direction = 0 468 512 469 470 513 jpoint=iextr+isgn 471 DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point .AND. & 472 icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest ) 473 jpoint=jpoint+isgn 474 ENDDO 514 DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point ) 515 IF( icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest )THEN ; jpoint=jpoint+isgn 516 ELSE ; EXIT 517 ENDIF 518 ENDDO 475 519 476 520 IF( cdextr=='bot_list')THEN ; istart=jpoint-1 ; iend=sec%nb_point 477 521 ELSE ; istart=1 ; iend=jpoint+1 478 522 ENDIF 523 479 524 sec%listPoint(1:1+iend-istart)%I = icoord(1,istart:iend) 480 525 sec%listPoint(1:1+iend-istart)%J = icoord(2,istart:iend) … … 487 532 ENDIF 488 533 534 CALL wrk_dealloc( nb_point_max, idirec ) 535 CALL wrk_dealloc( 2, nb_point_max, icoord ) 489 536 END SUBROUTINE removepoints 490 537 … … 536 583 537 584 TYPE(POINT_SECTION) :: k 538 REAL(wp), DIMENSION(nb_type_class,nb_class_max)::zsum585 REAL(wp), POINTER, DIMENSION(:,:):: zsum ! 2D work array 539 586 !!-------------------------------------------------------- 587 CALL wrk_alloc( nb_type_class , nb_class_max , zsum ) 540 588 541 589 IF( ld_debug )WRITE(numout,*)' Compute transport' … … 852 900 ENDIF 853 901 902 CALL wrk_dealloc( nb_type_class , nb_class_max , zsum ) 903 ! 854 904 END SUBROUTINE transport 855 905 … … 872 922 !!------------------------------------------------------------- 873 923 !!arguments 874 INTEGER, INTENT(IN) :: kt ! time-step875 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write876 INTEGER ,INTENT(IN) :: ksec ! section number924 INTEGER, INTENT(IN) :: kt ! time-step 925 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write 926 INTEGER ,INTENT(IN) :: ksec ! section number 877 927 878 928 !!local declarations 879 REAL(wp) ,DIMENSION(nb_type_class):: zsumclass 880 INTEGER :: jcl,ji ! Dummy loop 881 CHARACTER(len=2) :: classe ! Classname 882 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 883 REAL(wp) :: zslope ! section's slope coeff 929 INTEGER :: jcl,ji ! Dummy loop 930 CHARACTER(len=2) :: classe ! Classname 931 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 932 REAL(wp) :: zslope ! section's slope coeff 933 ! 934 REAL(wp), POINTER, DIMENSION(:):: zsumclass ! 1D workspace 884 935 !!------------------------------------------------------------- 885 936 CALL wrk_alloc(nb_type_class , zsumclass ) 937 886 938 zsumclass(:)=0._wp 887 939 zslope = sec%slopeSection … … 996 1048 119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6) 997 1049 1050 CALL wrk_dealloc(nb_type_class , zsumclass ) 998 1051 END SUBROUTINE dia_dct_wri 999 1052 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r2977 r3168 22 22 USE in_out_manager ! I/O manager 23 23 USE lib_mpp ! distributed memory computing library 24 USE timing ! preformance summary 24 25 25 26 IMPLICIT NONE … … 61 62 REAL(wp) :: zsm0, zfwfnew 62 63 !!---------------------------------------------------------------------- 64 IF( nn_timing == 1 ) CALL timing_start('dia_fwb') 63 65 64 66 ! Mean global salinity … … 438 440 ENDIF 439 441 442 IF( nn_timing == 1 ) CALL timing_start('dia_fwb') 443 440 444 9005 FORMAT(1X,A,ES24.16) 441 445 9010 FORMAT(1X,A,ES12.5,A,F10.5,A) -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r3104 r3168 16 16 USE dynspg_oce 17 17 USE dynspg_ts 18 USE surdetermine19 18 USE daymod 20 19 USE tide_mod 21 20 USE iom 21 USE timing ! preformance summary 22 USE wrk_nemo_2 ! working arrays 22 23 23 24 IMPLICIT NONE 24 25 PRIVATE 26 27 LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .TRUE. 25 28 26 INTEGER, PARAMETER :: nb_harmo_max=9 27 28 LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .TRUE. 29 30 INTEGER :: & !! namelist variables 31 nit000_han=1, & ! First time step used for harmonic analysis 32 nitend_han=1, & ! Last time step used for harmonic analysis 33 nstep_han=1, & ! Time step frequency for harmonic analysis 34 nb_ana ! Number of harmonics to analyse 29 INTEGER, PARAMETER :: nb_harmo_max = 9 30 INTEGER, PARAMETER :: jpincomax = 18 31 INTEGER, PARAMETER :: jpdimsparse = jpincomax*300*24 32 33 INTEGER :: & !! namelist variables 34 nit000_han = 1, & ! First time step used for harmonic analysis 35 nitend_han = 1, & ! Last time step used for harmonic analysis 36 nstep_han = 1 & ! Time step frequency for harmonic analysis 37 nb_ana ! Number of harmonics to analyse 38 39 INTEGER , ALLOCATABLE, DIMENSION(:) :: name 40 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp 41 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ana_freq, vt, ut, ft 42 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: out_eta, & 43 out_u , & 44 out_v 45 46 INTEGER , DIMENSION(jpdimsparse) :: njsparse, nisparse 47 INTEGER , SAVE, DIMENSION(jpincomax) :: ipos1 48 REAL(wp), DIMENSION(jpdimsparse) :: valuesparse 49 REAL(wp), DIMENSION(jpincomax) :: ztmp4 , ztmp7 50 REAL(wp), SAVE, DIMENSION(jpincomax,jpincomax) :: ztmp3 , zpilier 51 REAL(wp), SAVE, DIMENSION(jpincomax) :: zpivot 35 52 36 53 CHARACTER (LEN=4), DIMENSION(nb_harmo_max) :: & 37 54 tname ! Names of tidal constituents ('M2', 'K1',...) 38 55 39 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp40 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ana_freq, vt, ut, ft41 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: out_eta, &42 out_u, &43 out_v44 INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: name45 56 46 57 !! * Routine accessibility … … 162 173 163 174 !! * Local declarations 164 INTEGER :: ji, jj, jh, jc, nhc175 INTEGER :: ji, jj, jh, jc, nhc 165 176 REAL(wp) :: ztime, ztemp 177 !!-------------------------------------------------------------------- 178 IF( nn_timing == 1 ) CALL timing_start('dia_harm') 166 179 167 180 IF ( kt .EQ. nit000 ) CALL dia_harm_init … … 202 215 IF ( kt .EQ. nitend_han ) CALL dia_harm_end 203 216 217 IF( nn_timing == 1 ) CALL timing_stop('dia_harm') 204 218 205 219 END SUBROUTINE dia_harm … … 223 237 REAL(wp) :: ztime, ztime_ini, ztime_end 224 238 REAL(wp) :: X1,X2 225 REAL(wp), DIMENSION(jpi,jpj,nb_harmo_max,2) :: ana_amp 226 227 228 IF(lwp) WRITE(numout,*) 229 IF(lwp) WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis' 230 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 231 232 ztime_ini = nit000_han*rdt ! Initial time in seconds at the beginning of analysis 233 ztime_end = nitend_han*rdt ! Final time in seconds at the end of analysis 234 nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 235 236 ninco = 2*nb_ana 237 238 ksp = 0 239 keq = 0 240 DO jn = 1, nhan 241 ztime=( (nhan-jn)*ztime_ini + (jn-1)*ztime_end )/FLOAT(nhan-1) 242 keq = keq + 1 243 kun = 0 244 DO jh = 1,nb_ana 239 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp 240 !!-------------------------------------------------------------------- 241 CALL wrk_alloc( jpi , jpj , nb_harmo_max , 2 , ana_amp ) 242 243 IF(lwp) WRITE(numout,*) 244 IF(lwp) WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis' 245 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 246 247 ztime_ini = nit000_han*rdt ! Initial time in seconds at the beginning of analysis 248 ztime_end = nitend_han*rdt ! Final time in seconds at the end of analysis 249 nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 250 251 ninco = 2*nb_ana 252 253 ksp = 0 254 keq = 0 255 DO jn = 1, nhan 256 ztime=( (nhan-jn)*ztime_ini + (jn-1)*ztime_end )/FLOAT(nhan-1) 257 keq = keq + 1 258 kun = 0 259 DO jh = 1,nb_ana 245 260 DO jc = 1,2 246 kun = kun + 1247 ksp = ksp + 1248 nisparse(ksp) = keq249 njsparse(ksp) = kun250 valuesparse(ksp)= &251 +(MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) &261 kun = kun + 1 262 ksp = ksp + 1 263 nisparse(ksp) = keq 264 njsparse(ksp) = kun 265 valuesparse(ksp)= & 266 +( MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) & 252 267 +(1.-MOD(jc,2))* ft(jh) * SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 253 268 END DO 254 255 256 257 258 259 260 261 269 END DO 270 END DO 271 272 nsparse=ksp 273 274 ! Elevation: 275 DO jj = 1, jpj 276 DO ji = 1, jpi 262 277 ! Fill input array 263 278 kun=0 264 279 DO jh = 1,nb_ana 265 DO jc = 1,2266 kun = kun + 1267 tmp4(kun)=ana_temp(ji,jj,kun,1)268 ENDDO280 DO jc = 1,2 281 kun = kun + 1 282 tmp4(kun)=ana_temp(ji,jj,kun,1) 283 ENDDO 269 284 ENDDO 270 285 … … 273 288 ! Fill output array 274 289 DO jh = 1, nb_ana 275 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1)276 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2)290 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 291 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 277 292 END DO 278 END DO 279 END DO 280 281 ALLOCATE(out_eta(jpi,jpj,2*nb_ana)) 282 ALLOCATE(out_u (jpi,jpj,2*nb_ana)) 283 ALLOCATE(out_v (jpi,jpj,2*nb_ana)) 284 285 286 DO jj = 1, jpj 287 DO ji = 1, jpi 293 END DO 294 END DO 295 296 ALLOCATE(out_eta(jpi,jpj,2*nb_ana)) 297 ALLOCATE(out_u (jpi,jpj,2*nb_ana)) 298 ALLOCATE(out_v (jpi,jpj,2*nb_ana)) 299 300 DO jj = 1, jpj 301 DO ji = 1, jpi 288 302 DO jh = 1, nb_ana 289 290 291 292 293 ENDDO 294 295 296 297 298 299 303 X1=ana_amp(ji,jj,jh,1) 304 X2=-ana_amp(ji,jj,jh,2) 305 out_eta(ji,jj,jh)=X1 * tmask(ji,jj,1) 306 out_eta(ji,jj,nb_ana+jh)=X2 * tmask(ji,jj,1) 307 ENDDO 308 ENDDO 309 ENDDO 310 311 ! ubar: 312 DO jj = 1, jpj 313 DO ji = 1, jpi 300 314 ! Fill input array 301 315 kun=0 302 316 DO jh = 1,nb_ana 303 DO jc = 1,2304 kun = kun + 1305 tmp4(kun)=ana_temp(ji,jj,kun,2)306 ENDDO317 DO jc = 1,2 318 kun = kun + 1 319 tmp4(kun)=ana_temp(ji,jj,kun,2) 320 ENDDO 307 321 ENDDO 308 322 … … 311 325 ! Fill output array 312 326 DO jh = 1, nb_ana 313 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1)314 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2)327 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 328 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 315 329 END DO 316 330 317 318 319 320 321 331 END DO 332 END DO 333 334 DO jj = 1, jpj 335 DO ji = 1, jpi 322 336 DO jh = 1, nb_ana 323 324 325 326 327 ENDDO 328 329 330 331 332 333 334 335 336 337 337 X1=ana_amp(ji,jj,jh,1) 338 X2=-ana_amp(ji,jj,jh,2) 339 out_u(ji,jj,jh) = X1 * umask(ji,jj,1) 340 out_u (ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 341 ENDDO 342 ENDDO 343 ENDDO 344 345 ! vbar: 346 DO jj = 1, jpj 347 DO ji = 1, jpi 348 ! Fill input array 349 kun=0 350 DO jh = 1,nb_ana 351 DO jc = 1,2 338 352 kun = kun + 1 339 353 tmp4(kun)=ana_temp(ji,jj,kun,3) 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 354 ENDDO 355 ENDDO 356 357 CALL SUR_DETERMINE(jj+1) 358 359 ! Fill output array 360 DO jh = 1, nb_ana 361 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 362 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 363 END DO 364 365 END DO 366 END DO 367 368 DO jj = 1, jpj 369 DO ji = 1, jpi 356 370 DO jh = 1, nb_ana 357 X1=ana_amp(ji,jj,jh,1) 358 X2=-ana_amp(ji,jj,jh,2) 359 out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 360 out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 361 ENDDO 362 ENDDO 363 ENDDO 364 365 CALL dia_wri_harm ! Write results in files 366 371 X1=ana_amp(ji,jj,jh,1) 372 X2=-ana_amp(ji,jj,jh,2) 373 out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 374 out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 375 ENDDO 376 ENDDO 377 ENDDO 378 379 CALL dia_wri_harm ! Write results in files 380 381 CALL wrk_dealloc( jpi , jpj , nb_harmo_max , 2 , ana_amp ) 367 382 END SUBROUTINE dia_harm_end 368 383 … … 444 459 END SUBROUTINE dia_wri_harm 445 460 461 SUBROUTINE SUR_DETERMINE(init) 462 !!--------------------------------------------------------------------------------- 463 !! *** ROUTINE SUR_DETERMINE *** 464 !! 465 !! 466 !! 467 !!--------------------------------------------------------------------------------- 468 INTEGER, INTENT(in) :: init 469 470 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 471 REAL(wp) :: zval1, zval2, zx1 472 REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 473 INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 474 !--------------------------------------------------------------------------------- 475 CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 476 CALL wrk_alloc( jpincomax , ipos2 , ipivot ) 477 478 IF( init==1 )THEN 479 480 IF( nsparse .GT. jpdimsparse ) & 481 CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 482 483 IF( ninco .GT. jpincomax ) & 484 CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 485 486 ztmp3(:,:)=0.e0 487 488 DO jk1_sd = 1, nsparse 489 DO jk2_sd = 1, nsparse 490 491 nisparse(jk2_sd)=nisparse(jk2_sd) 492 njsparse(jk2_sd)=njsparse(jk2_sd) 493 494 IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 495 ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) & 496 + valuesparse(jk1_sd)*valuesparse(jk2_sd) 497 ENDIF 498 499 ENDDO 500 ENDDO 501 502 DO jj_sd = 1 ,ninco 503 ipos1(jj_sd) = jj_sd 504 ipos2(jj_sd) = jj_sd 505 ENDDO 506 507 DO ji_sd = 1 , ninco 508 509 !find greatest non-zero pivot: 510 zval1 = ABS(ztmp3(ji_sd,ji_sd)) 511 512 ipivot(ji_sd) = ji_sd 513 DO jj_sd = ji_sd, ninco 514 zval2 = ABS(ztmp3(ji_sd,jj_sd)) 515 IF( zval2.GE.zval1 )THEN 516 ipivot(ji_sd) = jj_sd 517 zval1 = zval2 518 ENDIF 519 ENDDO 520 521 DO ji1_sd = 1, ninco 522 zcol1(ji1_sd) = ztmp3(ji1_sd,ji_sd) 523 zcol2(ji1_sd) = ztmp3(ji1_sd,ipivot(ji_sd)) 524 ztmp3(ji1_sd,ji_sd) = zcol2(ji1_sd) 525 ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 526 ENDDO 527 528 ipos2(ji_sd) = ipos1(ipivot(ji_sd)) 529 ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 530 ipos1(ji_sd) = ipos2(ji_sd) 531 ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 532 zpivot(ji_sd) = ztmp3(ji_sd,ji_sd) 533 DO jj_sd = 1, ninco 534 ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 535 ENDDO 536 537 DO ji2_sd = ji_sd+1, ninco 538 zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 539 DO jj_sd=1,ninco 540 ztmp3(ji2_sd,jj_sd)= ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 541 ENDDO 542 ENDDO 543 544 ENDDO 545 546 ENDIF ! End init==1 547 548 DO ji_sd = 1, ninco 549 ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 550 DO ji2_sd = ji_sd+1, ninco 551 ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 552 ENDDO 553 ENDDO 554 555 !system solving: 556 ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 557 ji_sd = ninco 558 DO ji_sd = ninco-1, 1, -1 559 zx1=0. 560 DO jj_sd = ji_sd+1, ninco 561 zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 562 ENDDO 563 ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 564 ENDDO 565 566 DO jj_sd =1, ninco 567 ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 568 ENDDO 569 570 571 CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 572 CALL wrk_dealloc( jpincomax , ipos2 , ipivot ) 573 574 END SUBROUTINE SUR_DETERMINE 575 576 446 577 #else 447 578 !!---------------------------------------------------------------------- -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r3116 r3168 20 20 USE obc_par ! (for lk_obc) 21 21 USE bdy_par ! (for lk_bdy) 22 USE timing ! preformance summary 22 23 23 24 IMPLICIT NONE … … 72 73 REAL(dp) :: z_frc_trd_v ! - - 73 74 !!--------------------------------------------------------------------------- 75 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 74 76 75 77 ! ------------------------- ! … … 139 141 IF ( kt == nitend ) CLOSE( numhsb ) 140 142 143 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 144 141 145 9020 FORMAT(I5,11D15.7) 142 146 ! -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r3156 r3168 23 23 USE lib_mpp ! MPP library 24 24 USE iom ! I/O library 25 USE timing ! preformance summary 25 26 26 27 IMPLICIT NONE … … 103 104 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdelr ! delta rho equivalent to deltaT = 0.2 104 105 !!---------------------------------------------------------------------- 106 IF( nn_timing == 1 ) CALL timing_start('dia_hth') 105 107 106 108 IF( kt == nit000 ) THEN … … 322 324 DO jj = 1, jpj 323 325 DO ji = 1, jpi 326 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) & 327 * tmask(ji,jj,ilevel+1) 324 328 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) & 325 329 & * tmask(ji,jj,ilevel+1) … … 330 334 htc3(:,:) = zcoef * htc3(:,:) 331 335 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 336 ! 337 IF( nn_timing == 1 ) CALL timing_stop('dia_hth') 332 338 ! 333 339 END SUBROUTINE dia_hth -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r2977 r3168 29 29 USE lib_mpp ! MPP library 30 30 USE lbclnk ! lateral boundary condition - processor exchanges 31 USE timing ! preformance summary 32 USE wrk_nemo_2 ! working arrays 31 33 32 34 IMPLICIT NONE … … 209 211 !! ** Action : - p_fval: i-mean poleward flux of pva 210 212 !!---------------------------------------------------------------------- 211 #if defined key_mpp_mpi212 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released213 USE wrk_nemo, ONLY: zwork => wrk_1d_1214 #endif215 213 !! 216 214 IMPLICIT none … … 225 223 INTEGER :: ijpjjpk 226 224 #endif 225 #if defined key_mpp_mpi 226 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 227 #endif 227 228 !!-------------------------------------------------------------------- 228 229 ! 229 230 #if defined key_mpp_mpi 230 IF( wrk_in_use(1, 1) ) THEN 231 CALL ctl_stop('ptr_vjk: ERROR - requested workspace array is unavailable') ; RETURN 232 END IF 231 ijpjjpk = jpj*jpk 232 CALL wrk_alloc( ijpjjpk , zwork ) 233 233 #endif 234 234 … … 257 257 ! 258 258 #if defined key_mpp_mpi 259 ijpjjpk = jpj*jpk260 259 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 261 260 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) … … 265 264 ! 266 265 #if defined key_mpp_mpi 267 IF( wrk_not_released(1, 1) ) CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array')266 CALL wrk_dealloc( ijpjjpk , zwork ) 268 267 #endif 269 268 ! … … 281 280 !! ** Action : - p_fval: i-sum of e1t*e3t*pta 282 281 !!---------------------------------------------------------------------- 283 #if defined key_mpp_mpi284 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released285 USE wrk_nemo, ONLY: zwork => wrk_1d_1286 #endif287 282 !! 288 283 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point … … 296 291 INTEGER :: ijpjjpk 297 292 #endif 293 #if defined key_mpp_mpi 294 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 295 #endif 298 296 !!-------------------------------------------------------------------- 299 297 ! 300 298 #if defined key_mpp_mpi 301 IF( wrk_in_use(1, 1) ) THEN 302 CALL ctl_stop('ptr_tjk: requested workspace array unavailable') ; RETURN 303 ENDIF 299 ijpjjpk = jpj*jpk 300 CALL wrk_alloc( ijpjjpk , zwork ) 304 301 #endif 305 302 … … 315 312 END DO 316 313 #if defined key_mpp_mpi 317 ijpjjpk = jpj*jpk318 314 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 319 315 zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) … … 323 319 ! 324 320 #if defined key_mpp_mpi 325 IF( wrk_not_released(1, 1) ) CALL ctl_stop('ptr_tjk: failed to release workspace array')321 CALL wrk_dealloc( ijpjjpk , zwork ) 326 322 #endif 327 323 ! … … 342 338 REAL(wp) :: zv ! local scalar 343 339 !!---------------------------------------------------------------------- 340 ! 341 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 344 342 ! 345 343 IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN … … 430 428 ENDIF 431 429 ! 432 IF( kt == nitend ) CALL histclo( numptr ) ! Close the file 430 IF( kt == nitend .AND. l_znl_root ) CALL histclo( numptr ) ! Close the file 431 ! 432 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr') 433 433 ! 434 434 END SUBROUTINE dia_ptr … … 449 449 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 450 450 !!---------------------------------------------------------------------- 451 452 ! ! allocate dia_ptr arrays 453 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate arrays' ) 451 IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init') 454 452 455 453 REWIND( numnam ) ! Read Namelist namptr : poleward transport parameters … … 472 470 ELSE ; nptr = 1 ! Global only 473 471 ENDIF 472 473 ! ! allocate dia_ptr arrays 474 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate arrays' ) 474 475 475 476 rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt … … 520 521 #endif 521 522 ! 523 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init') 524 ! 522 525 END SUBROUTINE dia_ptr_init 523 526 … … 531 534 !! ** Method : NetCDF file 532 535 !!---------------------------------------------------------------------- 533 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released534 USE wrk_nemo, ONLY: zphi => wrk_1d_1, zfoo => wrk_1d_2 ! 1D workspace535 USE wrk_nemo, ONLY: z_1 => wrk_2d_1 ! 2D -536 536 !! 537 537 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 548 548 #endif 549 549 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 550 !!---------------------------------------------------------------------- 551 552 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1) ) THEN 553 CALL ctl_stop('dia_ptr_wri: requested workspace arrays unavailable') ; RETURN 554 ENDIF 550 !! 551 REAL(wp), POINTER, DIMENSION(:) :: zphi, zfoo ! 1D workspace 552 REAL(wp), POINTER, DIMENSION(:,:) :: z_1 ! 2D workspace 553 !!-------------------------------------------------------------------- 554 ! 555 CALL wrk_alloc( jpi , zphi , zfoo ) 556 CALL wrk_alloc( jpi , jpk, z_1 ) 555 557 556 558 ! define time axis … … 866 868 ENDIF 867 869 ! 868 IF( wrk_not_released(1, 1,2) .OR. &869 wrk_not_released(2, 1) ) CALL ctl_stop('dia_ptr_wri: failed to release workspace arrays')870 CALL wrk_dealloc( jpi , zphi , zfoo ) 871 CALL wrk_dealloc( jpi , jpk, z_1 ) 870 872 ! 871 873 END SUBROUTINE dia_ptr_wri -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r2977 r3168 47 47 #endif 48 48 USE lib_mpp ! MPP library 49 USE timing ! preformance summary 50 USE wrk_nemo_2 ! working array 49 51 50 52 IMPLICIT NONE … … 114 116 !! ** Method : use iom_put 115 117 !!---------------------------------------------------------------------- 116 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released117 USE wrk_nemo, ONLY: z3d => wrk_3d_1118 USE wrk_nemo, ONLY: z2d => wrk_2d_1119 118 !! 120 119 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 122 121 INTEGER :: ji, jj, jk ! dummy loop indices 123 122 REAL(wp) :: zztmp, zztmpx, zztmpy ! 123 !! 124 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 125 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 124 126 !!---------------------------------------------------------------------- 125 127 ! 126 IF( wrk_in_use(3, 1) .OR. wrk_in_use(2, 1) ) THEN 127 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') ; RETURN 128 END IF 128 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 129 ! 130 CALL wrk_alloc( jpi , jpj , z2d ) 131 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 129 132 ! 130 133 ! Output the initial state and forcings … … 197 200 ENDIF 198 201 ! 199 IF( wrk_not_released(3, 1) .OR. wrk_not_released(2, 1) ) THEN200 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.')201 RETURN202 END IF202 CALL wrk_dealloc( jpi , jpj , z2d ) 203 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 204 ! 205 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 203 206 ! 204 207 END SUBROUTINE dia_wri … … 221 224 !! Each nwrite time step, output the instantaneous or mean fields 222 225 !!---------------------------------------------------------------------- 223 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released224 USE wrk_nemo, ONLY: zw2d => wrk_2d_1225 226 !! 226 227 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 231 232 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 232 233 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 234 !! 235 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace 233 236 !!---------------------------------------------------------------------- 234 ! 235 IF( wrk_in_use(2, 1))THEN 236 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 237 RETURN 238 END IF 237 ! 238 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 239 ! 240 CALL wrk_alloc( jpi , jpj , zw2d ) 239 241 ! 240 242 ! Output the initial state and forcings … … 605 607 ENDIF 606 608 ! 607 IF( wrk_not_released(2, 1))THEN 608 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 609 RETURN 610 END IF 609 CALL wrk_dealloc( jpi , jpj , zw2d ) 610 ! 611 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 611 612 ! 612 613 END SUBROUTINE dia_wri … … 637 638 REAL(wp) :: zsto, zout, zmax, zjulian, zdt 638 639 !!---------------------------------------------------------------------- 640 ! 641 IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') 639 642 640 643 ! 0. Initialisation … … 732 735 ENDIF 733 736 #endif 737 738 IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') 739 ! 734 740 735 741 END SUBROUTINE dia_wri_state -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r2977 r3168 88 88 CHARACTER(LEN= 4) :: clver 89 89 !!---------------------------------------------------------------------- 90 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 90 91 ! 91 92 ! Initialization … … 357 358 ENDIF 358 359 ! 360 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 361 ! 359 362 9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") 360 363 !
Note: See TracChangeset
for help on using the changeset viewer.
