- Timestamp:
- 2012-11-19T17:00:49+01:00 (11 years ago)
- Location:
- branches/2012/dev_NOC_2012_rev3555/NEMOGCM
- Files:
-
- 11 edited
-
CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro (modified) (2 diffs)
-
CONFIG/ORCA2_LIM/IDL_scripts/std_ts_T.pro (modified) (2 diffs)
-
CONFIG/ORCA2_LIM/IDL_scripts/std_ts_read.pro (modified) (1 diff)
-
EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90 (modified) (4 diffs)
-
NEMO/LIM_SRC_3/limistate.F90 (modified) (1 diff)
-
NEMO/LIM_SRC_3/limthd_dif.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/BDY/bdyice_lim2.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/ZDF/zdfddm.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/nemogcm.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/timing.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro
r2759 r3610 31 31 32 32 ; read exp1 data 33 std_ts_read, vsal, date1, date2, prefix, suffix, ts_Sal, ts_z $33 std_ts_read, vsal, date1, date2, prefix, suffix, ts_Sal, ts_z, masknp $ 34 34 , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 35 35 … … 62 62 ; read exp2 data 63 63 tsave = time 64 std_ts_read, vsal2, date1_2, date2_2, prefix2, suffix2, ts_Sal2, ts_z2 $64 std_ts_read, vsal2, date1_2, date2_2, prefix2, suffix2, ts_Sal2, ts_z2, masknp $ 65 65 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz 66 66 time = tsave & IF n_elements(time) NE jpt THEN stop -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_T.pro
r2751 r3610 31 31 32 32 ; read exp1 data 33 std_ts_read, vtemp, date1, date2, prefix, suffix, ts_Temp, ts_z $33 std_ts_read, vtemp, date1, date2, prefix, suffix, ts_Temp, ts_z, masknp $ 34 34 , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 35 35 … … 62 62 ; read exp2 data 63 63 tsave = time 64 std_ts_read, vtemp2, date1_2, date2_2, prefix2, suffix2, ts_Temp2, ts_z2 $64 std_ts_read, vtemp2, date1_2, date2_2, prefix2, suffix2, ts_Temp2, ts_z2, masknp $ 65 65 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz 66 66 time = tsave & IF n_elements(time) NE jpt THEN stop -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_read.pro
r2751 r3610 1 PRO std_ts_read, var_name, dt1, dt2, prefix, suffix, ts, ts_z $1 PRO std_ts_read, var_name, dt1, dt2, prefix, suffix, ts, ts_z, masknp $ 2 2 , WITHSSH = withssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 3 3 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90
r2458 r3610 38 38 USE ioipsl 39 39 USE xmlio 40 USE mod_ioserver_namelist 40 41 IMPLICIT NONE 41 42 INTEGER,INTENT(IN) :: nb_server … … 88 89 pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc, & 89 90 initial_timestep, initial_date, timestep_value, & 90 ioipsl_hori_id, ioipsl_file_id )91 ioipsl_hori_id, ioipsl_file_id, snc4chunks=snc4ioset) 91 92 ELSE 92 93 … … 95 96 pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc, & 96 97 initial_timestep, initial_date, timestep_value, & 97 ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id )98 ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id, snc4chunks=snc4ioset) 98 99 99 100 ENDIF … … 142 143 ENDIF 143 144 ENDDO 144 CALL histend(ioipsl_file_id )145 CALL histend(ioipsl_file_id, snc4chunks=snc4ioset) 145 146 ENDIF 146 147 CALL sorted_list__delete(axis_id) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r3294 r3610 460 460 ! 4) Moments for advection 461 461 !-------------------------------------------------------------------- 462 463 sxopw (:,:) = 0.e0 464 syopw (:,:) = 0.e0 465 sxxopw(:,:) = 0.e0 466 syyopw(:,:) = 0.e0 467 sxyopw(:,:) = 0.e0 462 468 463 469 sxice (:,:,:) = 0.e0 ; sxsn (:,:,:) = 0.e0 ; sxa (:,:,:) = 0.e0 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r3294 r3610 102 102 INTEGER :: nconv ! number of iterations in iterative procedure 103 103 INTEGER :: minnumeqmin, maxnumeqmax 104 105 INTEGER , POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 106 INTEGER , POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 107 INTEGER , POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 108 109 !! * New local variables 110 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i !Ice thermal conductivity 111 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i !Radiation transmitted through the ice 112 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i !Radiation absorbed in the ice 113 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i !Kappa factor in the ice 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s !Radiation transmited through the snow 116 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s !Radiation absorbed in the snow 117 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s !Kappa factor in the snow 118 119 REAL(wp), POINTER, DIMENSION(:,:) :: ztiold !Old temperature in the ice 120 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i !Eta factor in the ice 121 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp !Temporary temperature in the ice to check the convergence 122 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i !Ice specific heat 123 REAL(wp), POINTER, DIMENSION(:,:) :: z_i !Vertical cotes of the layers in the ice 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s !Eta factor in the snow 126 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp !Temporary temperature in the snow to check the convergence 127 REAL(wp), POINTER, DIMENSION(:,:) :: ztsold !Temporary temperature in the snow 128 REAL(wp), POINTER, DIMENSION(:,:) :: z_s !Vertical cotes of the layers in the snow 129 130 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! Independent term 131 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! temporary independent term 132 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 134 135 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 136 REAL(wp), POINTER, DIMENSION(:) :: ztsuold ! old surface temperature (before the iterative procedure ) 137 REAL(wp), POINTER, DIMENSION(:) :: ztsuoldit ! surface temperature at previous iteration 138 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 139 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 140 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 141 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 142 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 143 104 INTEGER, DIMENSION(kiut) :: numeqmin ! reference number of top equation 105 INTEGER, DIMENSION(kiut) :: numeqmax ! reference number of bottom equation 106 INTEGER, DIMENSION(kiut) :: isnow ! switch for presence (1) or absence (0) of snow 144 107 REAL(wp) :: zeps = 1.e-10_wp ! 145 108 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system … … 150 113 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 151 114 REAL(wp) :: zht_smin = 1.e-4_wp ! minimum snow depth 152 153 115 REAL(wp) :: ztmelt_i ! ice melting temperature 154 116 REAL(wp) :: zerritmax ! current maximal error on temperature 155 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 156 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 157 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 158 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 117 REAL(wp), DIMENSION(kiut) :: ztfs ! ice melting point 118 REAL(wp), DIMENSION(kiut) :: ztsuold ! old surface temperature (before the iterative procedure ) 119 REAL(wp), DIMENSION(kiut) :: ztsuoldit ! surface temperature at previous iteration 120 REAL(wp), DIMENSION(kiut) :: zh_i ! ice layer thickness 121 REAL(wp), DIMENSION(kiut) :: zh_s ! snow layer thickness 122 REAL(wp), DIMENSION(kiut) :: zfsw ! solar radiation absorbed at the surface 123 REAL(wp), DIMENSION(kiut) :: zf ! surface flux function 124 REAL(wp), DIMENSION(kiut) :: dzf ! derivative of the surface flux function 125 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature 126 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4) 127 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice 128 REAL(wp), DIMENSION(kiut) :: zihic, zhsu 129 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 130 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 131 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 132 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 133 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztiold ! Old temperature in the ice 134 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zeta_i ! Eta factor in the ice 135 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztitemp ! Temporary temperature in the ice to check the convergence 136 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zspeche_i ! Ice specific heat 137 REAL(wp), DIMENSION(kiut,0:nlay_i) :: z_i ! Vertical cotes of the layers in the ice 138 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 139 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 140 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 141 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zeta_s ! Eta factor in the snow 142 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztstemp ! Temporary temperature in the snow to check the convergence 143 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztsold ! Temporary temperature in the snow 144 REAL(wp), DIMENSION(kiut,0:nlay_s) :: z_s ! Vertical cotes of the layers in the snow 145 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindterm ! Independent term 146 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindtbis ! temporary independent term 147 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 148 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 159 149 !!------------------------------------------------------------------ 160 ! 161 CALL wrk_alloc( kiut, numeqmin, numeqmax, isnow ) ! integer 162 CALL wrk_alloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 ) 163 CALL wrk_alloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 ) 164 CALL wrk_alloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis ) 165 CALL wrk_alloc( kiut,jkmax+2,3, ztrid ) 166 CALL wrk_alloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf ) 167 CALL wrk_alloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu ) 168 150 151 ! 169 152 !------------------------------------------------------------------------------! 170 153 ! 1) Initialization ! … … 772 755 ENDIF 773 756 ! 774 CALL wrk_dealloc( kiut, numeqmin, numeqmax, isnow ) ! integer775 CALL wrk_dealloc( kiut,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, zspeche_i, z_i, kjstart=0 )776 CALL wrk_dealloc( kiut,nlay_s+1, zradtr_s, zradab_s, zkappa_s, zeta_s, ztstemp, ztsold, z_s, kjstart=0 )777 CALL wrk_dealloc( kiut,jkmax+2, zindterm, zindtbis, zdiagbis )778 CALL wrk_dealloc( kiut,jkmax+2,3, ztrid )779 CALL wrk_dealloc( kiut, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw, zf, dzf )780 CALL wrk_dealloc( kiut, zerrit, zdifcase, zftrice, zihic, zhsu )781 782 757 END SUBROUTINE lim_thd_dif 783 758 -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90
r3294 r3610 53 53 CYCLE 54 54 CASE(jp_frs) 55 CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_ idx(ib_bdy) )55 CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) ) 56 56 CASE DEFAULT 57 57 CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' ) -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r3294 r3610 332 332 !!---------------------------------------------------------------------- 333 333 USE oce, vt => ua ! use ua as workspace 334 USE oce, vs => ua ! use ua as workspace334 USE oce, vs => va ! use va as workspace 335 335 IMPLICIT none 336 336 !! … … 378 378 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 379 379 #endif 380 vt( :,jj,jk) = zv * tsn(:,jj,jk,jp_tem)381 vs( :,jj,jk) = zv * tsn(:,jj,jk,jp_sal)380 vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 381 vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 382 382 END DO 383 383 END DO -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r3294 r3610 227 227 ENDIF 228 228 ! 229 ! ! allocate zdfddm arrays229 ! ! allocate zdfddm arrays 230 230 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 231 ! ! initialization to masked Kz 232 avs(:,:,:) = rn_avt0 * tmask(:,:,:) 231 233 ! 232 234 END SUBROUTINE zdf_ddm_init -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3609 r3610 412 412 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 413 413 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench 414 WRITE(numout,*) ' timing activated (0/1) nn_timing = ', nn_timing 414 415 ENDIF 415 416 ! -
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/timing.F90
r3294 r3610 76 76 LOGICAL :: ln_onefile = .TRUE. 77 77 LOGICAL :: lwriter 78 79 78 !!---------------------------------------------------------------------- 80 79 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 322 321 IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :' 323 322 IF( lwriter ) WRITE(numtime,*) '--------------------' 324 IF( lwriter ) WRITE(numtime, *) 'Elapsed Time (s) ','CPU Time (s)'325 IF( lwriter ) WRITE(numtime,'(5x,f12.3, 2x,f12.3)') tot_etime, tot_ctime323 IF( lwriter ) WRITE(numtime,"('Elapsed Time (s) CPU Time (s)')") 324 IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)') tot_etime, tot_ctime 326 325 IF( lwriter ) WRITE(numtime,*) 327 326 #if defined key_mpp_mpi … … 406 405 TYPE(timer), POINTER :: sl_timer_ave => NULL() 407 406 INTEGER :: icode 407 INTEGER :: ierr 408 408 LOGICAL :: ll_ord 409 409 CHARACTER(len=200) :: clfmt 410 410 411 411 ! Initialised the global strucutre 412 ALLOCATE(sl_timer_glob_root) 413 ALLOCATE(sl_timer_glob_root%cname (jpnij)) 414 ALLOCATE(sl_timer_glob_root%tsum_cpu (jpnij)) 415 ALLOCATE(sl_timer_glob_root%tsum_clock(jpnij)) 416 ALLOCATE(sl_timer_glob_root%niter (jpnij)) 412 ALLOCATE(sl_timer_glob_root, Stat=ierr) 413 IF(ierr /= 0)THEN 414 WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info' 415 RETURN 416 END IF 417 418 ALLOCATE(sl_timer_glob_root%cname (jpnij), & 419 sl_timer_glob_root%tsum_cpu (jpnij), & 420 sl_timer_glob_root%tsum_clock(jpnij), & 421 sl_timer_glob_root%niter (jpnij), Stat=ierr) 422 IF(ierr /= 0)THEN 423 WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info' 424 RETURN 425 END IF 417 426 sl_timer_glob_root%cname(:) = '' 418 427 sl_timer_glob_root%tsum_cpu(:) = 0._wp … … 421 430 sl_timer_glob_root%next => NULL() 422 431 sl_timer_glob_root%prev => NULL() 423 ALLOCATE(sl_timer_glob) 424 ALLOCATE(sl_timer_glob%cname (jpnij)) 425 ALLOCATE(sl_timer_glob%tsum_cpu (jpnij)) 426 ALLOCATE(sl_timer_glob%tsum_clock(jpnij)) 427 ALLOCATE(sl_timer_glob%niter (jpnij)) 432 !ARPDBG - don't need to allocate a pointer that's immediately then 433 ! set to point to some other object. 434 !ALLOCATE(sl_timer_glob) 435 !ALLOCATE(sl_timer_glob%cname (jpnij)) 436 !ALLOCATE(sl_timer_glob%tsum_cpu (jpnij)) 437 !ALLOCATE(sl_timer_glob%tsum_clock(jpnij)) 438 !ALLOCATE(sl_timer_glob%niter (jpnij)) 428 439 sl_timer_glob => sl_timer_glob_root 429 440 ! … … 451 462 sl_timer_ave => sl_timer_ave_root 452 463 ENDIF 453 464 454 465 ! Gather info from all processors 455 466 s_timer => s_timer_root … … 467 478 sl_timer_glob%niter, 1, MPI_INTEGER, & 468 479 0, MPI_COMM_OPA, icode) 480 469 481 IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN 470 482 ALLOCATE(sl_timer_glob%next) … … 479 491 s_timer => s_timer%next 480 492 END DO 493 494 WRITE(*,*) 'ARPDBG: timing: done gathers' 481 495 482 496 IF( narea == 1 ) THEN … … 500 514 ENDIF 501 515 sl_timer_glob => sl_timer_glob%next 502 END DO 516 END DO 517 518 WRITE(*,*) 'ARPDBG: timing: done computing stats' 503 519 504 ! reorder the ave arged list by CPU time520 ! reorder the averaged list by CPU time 505 521 s_wrk => NULL() 506 522 sl_timer_ave => sl_timer_ave_root … … 509 525 sl_timer_ave => sl_timer_ave_root 510 526 DO WHILE( ASSOCIATED( sl_timer_ave%next ) ) 511 IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT 527 528 IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT 529 512 530 IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 513 531 ALLOCATE(s_wrk) 532 ! Copy data into the new object pointed to by s_wrk 514 533 s_wrk = sl_timer_ave%next 534 ! Insert this new timer object before our current position 515 535 CALL insert (sl_timer_ave, sl_timer_ave_root, s_wrk) 536 ! Remove the old object from the list 516 537 CALL suppress(sl_timer_ave%next) 517 538 ll_ord = .FALSE. 518 539 CYCLE 519 540 ENDIF 520 IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next541 IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next 521 542 END DO 522 IF( ll_ord ) EXIT543 IF( ll_ord ) EXIT 523 544 END DO 524 545 525 546 ! write averaged info 526 WRITE(numtime,*) 'Averaged timing on all processors :' 527 WRITE(numtime,*) '-----------------------------------' 528 WRITE(numtime,*) 'Section ', & 529 & 'Elapsed Time (s) ','Elapsed Time (%) ', & 530 & 'CPU Time(s) ','CPU Time (%) ','CPU/Elapsed ', & 531 & 'Max Elapsed (%) ','Min elapsed (%) ', & 532 & 'Frequency' 547 WRITE(numtime,"('Averaged timing on all processors :')") 548 WRITE(numtime,"('-----------------------------------')") 549 WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, & 550 & 'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x, & 551 & 'Max elap(%)',2x,'Min elap(%)',2x, & 552 & 'Freq')") 533 553 sl_timer_ave => sl_timer_ave_root 534 clfmt = '( 1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,5x,f12.3,5x,f12.3,2x,f9.2)'554 clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)' 535 555 DO WHILE ( ASSOCIATED(sl_timer_ave) ) 536 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname , &556 WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), & 537 557 & sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime, & 538 558 & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & … … 712 732 !!---------------------------------------------------------------------- 713 733 l_initdone = .TRUE. 714 IF(lwp) WRITE(numout,*)715 IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'716 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'717 CALL timing_list(s_timer_root)718 WRITE(numout,*)734 ! IF(lwp) WRITE(numout,*) 735 ! IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing' 736 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 737 ! CALL timing_list(s_timer_root) 738 ! WRITE(numout,*) 719 739 ! 720 740 END SUBROUTINE timing_reset … … 734 754 !!---------------------------------------------------------------------- 735 755 !! *** ROUTINE insert *** 736 !! ** Purpose : insert an element in 756 !! ** Purpose : insert an element in timer structure 737 757 !!---------------------------------------------------------------------- 738 758 TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr … … 740 760 741 761 IF( ASSOCIATED( sd_current, sd_root ) ) THEN 762 ! If our current element is the root element then 763 ! replace it with the one being inserted 742 764 sd_root => sd_ptr 743 765 ELSE … … 747 769 sd_ptr%prev => sd_current%prev 748 770 sd_current%prev => sd_ptr 771 ! Nullify the pointer to the new element now that it is held 772 ! within the list. If we don't do this then a subsequent call 773 ! to ALLOCATE memory to this pointer will fail. 774 sd_ptr => NULL() 749 775 ! 750 776 END SUBROUTINE insert … … 764 790 IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev 765 791 DEALLOCATE(sl_temp) 792 sl_temp => NULL() 766 793 ! 767 794 END SUBROUTINE suppress
Note: See TracChangeset
for help on using the changeset viewer.
