New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3610 – NEMO

Changeset 3610


Ignore:
Timestamp:
2012-11-19T17:00:49+01:00 (12 years ago)
Author:
acc
Message:

Branch dev_NOC_2012_r3555. #1006. Step 5: Merge in trunk changes between revision 3337 and 3385

Location:
branches/2012/dev_NOC_2012_rev3555/NEMOGCM
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro

    r2759 r3610  
    3131 
    3232; 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 $ 
    3434               , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 
    3535 
     
    6262; read exp2 data 
    6363    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 $ 
    6565                 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz 
    6666    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  
    3131 
    3232; 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 $ 
    3434               , WITHSSH = vssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 
    3535 
     
    6262; read exp2 data 
    6363    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 $ 
    6565                 , WITHSSH = vssh2, SSHPREFIX = sshprefix2, SSHSUFFIX = sshsuffix2, LEVZ = levz 
    6666    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 $ 
     1PRO std_ts_read, var_name, dt1, dt2, prefix, suffix, ts, ts_z, masknp $ 
    22                 , WITHSSH = withssh, SSHPREFIX = sshprefix, SSHSUFFIX = sshsuffix, LEVZ = levz 
    33 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90

    r2458 r3610  
    3838  USE ioipsl 
    3939  USE xmlio 
     40  USE mod_ioserver_namelist 
    4041  IMPLICIT NONE 
    4142    INTEGER,INTENT(IN)  :: nb_server 
     
    8889                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         & 
    8990                       initial_timestep, initial_date, timestep_value,                               & 
    90                        ioipsl_hori_id, ioipsl_file_id) 
     91                       ioipsl_hori_id, ioipsl_file_id, snc4chunks=snc4ioset) 
    9192           ELSE                                               
    9293 
     
    9596                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          & 
    9697                       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)                                               
    9899           
    99100           ENDIF 
     
    142143            ENDIF 
    143144          ENDDO 
    144           CALL histend(ioipsl_file_id) 
     145          CALL histend(ioipsl_file_id, snc4chunks=snc4ioset) 
    145146        ENDIF 
    146147        CALL sorted_list__delete(axis_id) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r3294 r3610  
    460460      ! 4) Moments for advection 
    461461      !-------------------------------------------------------------------- 
     462 
     463      sxopw (:,:) = 0.e0  
     464      syopw (:,:) = 0.e0  
     465      sxxopw(:,:) = 0.e0  
     466      syyopw(:,:) = 0.e0  
     467      sxyopw(:,:) = 0.e0 
    462468 
    463469      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  
    102102      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    103103      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 
    144107      REAL(wp) ::   zeps      =  1.e-10_wp    ! 
    145108      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
     
    150113      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
    151114      REAL(wp) ::   zht_smin  =  1.e-4_wp     ! minimum snow depth 
    152  
    153115      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    154116      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 
    159149      !!------------------------------------------------------------------ 
    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      !  
    169152      !------------------------------------------------------------------------------! 
    170153      ! 1) Initialization                                                            ! 
     
    772755      ENDIF 
    773756      ! 
    774       CALL wrk_dealloc( kiut, numeqmin, numeqmax, isnow )   ! integer 
    775       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  
    782757   END SUBROUTINE lim_thd_dif 
    783758 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

    r3294 r3610  
    5353            CYCLE 
    5454         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) ) 
    5656         CASE DEFAULT 
    5757            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  
    332332      !!---------------------------------------------------------------------- 
    333333      USE oce,     vt  =>   ua   ! use ua as workspace 
    334       USE oce,     vs  =>   ua   ! use ua as workspace 
     334      USE oce,     vs  =>   va   ! use va as workspace 
    335335      IMPLICIT none 
    336336      !! 
     
    378378                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    379379#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) 
    382382                  END DO 
    383383               END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r3294 r3610  
    227227      ENDIF 
    228228      ! 
    229       !                              ! allocate zdfddm arrays 
     229      !                               ! allocate zdfddm arrays 
    230230      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(:,:,:)  
    231233      ! 
    232234   END SUBROUTINE zdf_ddm_init 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3609 r3610  
    412412         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    413413         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     414         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    414415      ENDIF 
    415416      ! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/timing.F90

    r3294 r3610  
    7676   LOGICAL :: ln_onefile = .TRUE.  
    7777   LOGICAL :: lwriter 
    78  
    7978   !!---------------------------------------------------------------------- 
    8079   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    322321      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :' 
    323322      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_ctime 
     323      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 
    326325      IF( lwriter ) WRITE(numtime,*)  
    327326#if defined key_mpp_mpi 
     
    406405      TYPE(timer), POINTER :: sl_timer_ave      => NULL() 
    407406      INTEGER :: icode 
     407      INTEGER :: ierr 
    408408      LOGICAL :: ll_ord            
    409409      CHARACTER(len=200) :: clfmt               
    410410                  
    411411      ! 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 
    417426      sl_timer_glob_root%cname(:)       = '' 
    418427      sl_timer_glob_root%tsum_cpu(:)   = 0._wp 
     
    421430      sl_timer_glob_root%next => NULL() 
    422431      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)) 
    428439      sl_timer_glob => sl_timer_glob_root 
    429440      ! 
     
    451462         sl_timer_ave => sl_timer_ave_root             
    452463      ENDIF  
    453        
     464 
    454465      ! Gather info from all processors 
    455466      s_timer => s_timer_root 
     
    467478                         sl_timer_glob%niter, 1, MPI_INTEGER,   & 
    468479                         0, MPI_COMM_OPA, icode) 
     480 
    469481         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN 
    470482            ALLOCATE(sl_timer_glob%next) 
     
    479491         s_timer => s_timer%next 
    480492      END DO       
     493 
     494         WRITE(*,*) 'ARPDBG: timing: done gathers' 
    481495       
    482496      IF( narea == 1 ) THEN     
     
    500514            ENDIF 
    501515            sl_timer_glob => sl_timer_glob%next                                 
    502          END DO          
     516         END DO 
     517 
     518         WRITE(*,*) 'ARPDBG: timing: done computing stats' 
    503519       
    504          ! reorder the avearged list by CPU time       
     520         ! reorder the averaged list by CPU time       
    505521         s_wrk => NULL() 
    506522         sl_timer_ave => sl_timer_ave_root 
     
    509525            sl_timer_ave => sl_timer_ave_root 
    510526            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 
    512530               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN  
    513531                  ALLOCATE(s_wrk) 
     532                  ! Copy data into the new object pointed to by s_wrk 
    514533                  s_wrk = sl_timer_ave%next 
     534                  ! Insert this new timer object before our current position 
    515535                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk) 
     536                  ! Remove the old object from the list 
    516537                  CALL suppress(sl_timer_ave%next)             
    517538                  ll_ord = .FALSE. 
    518539                  CYCLE             
    519540               ENDIF            
    520             IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next 
     541               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next 
    521542            END DO          
    522            IF( ll_ord ) EXIT 
     543            IF( ll_ord ) EXIT 
    523544         END DO 
    524545 
    525546         ! 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')") 
    533553         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)' 
    535555         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),                            & 
    537557            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   & 
    538558            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   & 
     
    712732      !!---------------------------------------------------------------------- 
    713733      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,*) 
    719739      ! 
    720740   END SUBROUTINE timing_reset 
     
    734754      !!---------------------------------------------------------------------- 
    735755      !!               ***  ROUTINE insert  *** 
    736       !! ** Purpose :   insert an element in  imer structure 
     756      !! ** Purpose :   insert an element in timer structure 
    737757      !!---------------------------------------------------------------------- 
    738758      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr 
     
    740760      
    741761      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 
    742764         sd_root => sd_ptr 
    743765      ELSE 
     
    747769      sd_ptr%prev     => sd_current%prev 
    748770      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() 
    749775      !     
    750776   END SUBROUTINE insert 
     
    764790      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev 
    765791      DEALLOCATE(sl_temp) 
     792      sl_temp => NULL() 
    766793      ! 
    767794    END SUBROUTINE suppress 
Note: See TracChangeset for help on using the changeset viewer.