Changeset 3162 for branches/2011/dev_NEMO_MERGE_2011/NEMOGCM
- Timestamp:
- 2011-11-20T17:38:17+01:00 (12 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 15 edited
-
DOM/daymod.F90 (modified) (5 diffs)
-
DOM/domain.F90 (modified) (3 diffs)
-
DOM/domcfg.F90 (modified) (3 diffs)
-
DOM/domhgr.F90 (modified) (3 diffs)
-
DOM/dommsk.F90 (modified) (5 diffs)
-
DOM/domngb.F90 (modified) (4 diffs)
-
DOM/domvvl.F90 (modified) (5 diffs)
-
DOM/domwri.F90 (modified) (7 diffs)
-
DOM/domzgr.F90 (modified) (19 diffs)
-
DOM/dtatsd.F90 (modified) (7 diffs)
-
DOM/istate.F90 (modified) (6 diffs)
-
SOL/solmat.F90 (modified) (3 diffs)
-
SOL/solpcg.F90 (modified) (4 diffs)
-
SOL/solsor.F90 (modified) (4 diffs)
-
SOL/solver.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r2715 r3162 34 34 USE restart ! 35 35 USE trc_oce, ONLY : lk_offline ! offline flag 36 USE timing ! Timing 36 37 37 38 IMPLICIT NONE … … 70 71 REAL(wp) :: zjul 71 72 !!---------------------------------------------------------------------- 72 73 ! 74 IF( nn_timing == 1 ) CALL timing_start('day_init') 75 ! 73 76 ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 74 77 IF( MOD( rday , rdttra(1) ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) … … 127 130 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 128 131 CALL day( nit000 ) 129 132 ! 133 IF( nn_timing == 1 ) CALL timing_stop('day_init') 134 ! 130 135 END SUBROUTINE day_init 131 136 … … 204 209 REAL(wp) :: zprec ! fraction of day corresponding to 0.1 second 205 210 !!---------------------------------------------------------------------- 211 ! 212 IF( nn_timing == 1 ) CALL timing_start('day') 213 ! 206 214 zprec = 0.1 / rday 207 215 ! ! New time-step … … 255 263 IF( .NOT. lk_offline ) CALL rst_opn( kt ) ! Open the restart file if needed and control lrst_oce 256 264 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) ! write day restart information 265 ! 266 IF( nn_timing == 1 ) CALL timing_stop('day') 257 267 ! 258 268 END SUBROUTINE day -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r2528 r3162 35 35 USE c1d ! 1D vertical configuration 36 36 USE dyncor_c1d ! Coriolis term (c1d case) (cor_c1d routine) 37 USE timing ! Timing 37 38 38 39 IMPLICIT NONE … … 70 71 !!---------------------------------------------------------------------- 71 72 ! 73 IF( nn_timing == 1 ) CALL timing_start('dom_init') 74 ! 72 75 IF(lwp) THEN 73 76 WRITE(numout,*) … … 102 105 IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file 103 106 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 107 ! 108 IF( nn_timing == 1 ) CALL timing_stop('dom_init') 104 109 ! 105 110 END SUBROUTINE dom_init -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
r2715 r3162 15 15 USE in_out_manager ! I/O manager 16 16 USE lib_mpp ! distributed memory computing library 17 USE timing ! Timing 17 18 18 19 IMPLICIT NONE … … 35 36 !! 36 37 !!---------------------------------------------------------------------- 37 38 ! 39 IF( nn_timing == 1 ) CALL timing_start('dom_cfg') 40 ! 38 41 IF(lwp) THEN ! Control print 39 42 WRITE(numout,*) … … 56 59 ! 57 60 CALL dom_glo ! global domain versus zoom and/or local domain 61 ! 62 IF( nn_timing == 1 ) CALL timing_stop('dom_cfg') 58 63 ! 59 64 END SUBROUTINE dom_cfg -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r2715 r3162 25 25 USE in_out_manager ! I/O manager 26 26 USE lib_mpp ! MPP library 27 USE timing ! Timing 27 28 28 29 IMPLICIT NONE … … 105 106 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 106 107 !!---------------------------------------------------------------------- 107 108 ! 109 IF( nn_timing == 1 ) CALL timing_start('dom_hgr') 110 ! 108 111 IF(lwp) THEN 109 112 WRITE(numout,*) … … 568 571 IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 569 572 ENDIF 570 573 ! 574 IF( nn_timing == 1 ) CALL timing_stop('dom_hgr') 575 ! 571 576 END SUBROUTINE dom_hgr 572 577 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r3116 r3162 29 29 USE lib_mpp 30 30 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 31 USE wrk_nemo_2 ! Memory allocation 32 USE timing ! Timing 31 33 32 34 IMPLICIT NONE … … 127 129 !! tmask_i : interior ocean mask 128 130 !!---------------------------------------------------------------------- 129 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released130 USE wrk_nemo, ONLY: zwf => wrk_2d_1 ! 2D real workspace131 USE wrk_nemo, ONLY: imsk => iwrk_2d_1 ! 2D integer workspace132 131 ! 133 132 INTEGER :: ji, jj, jk ! dummy loop indices 134 133 INTEGER :: iif, iil, ii0, ii1, ii ! local integers 135 134 INTEGER :: ijf, ijl, ij0, ij1 ! - - 135 INTEGER , POINTER, DIMENSION(:,:) :: imsk 136 REAL(wp), POINTER, DIMENSION(:,:) :: zwf 136 137 !! 137 138 NAMELIST/namlbc/ rn_shlat, ln_vorlat 138 139 !!--------------------------------------------------------------------- 139 140 IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) ) THEN 141 CALL ctl_stop('dom_msk: requested workspace arrays unavailable') ; RETURN 142 ENDIF 143 140 ! 141 IF( nn_timing == 1 ) CALL timing_start('dom_msk') 142 ! 143 CALL wrk_alloc( jpi, jpj, imsk ) 144 CALL wrk_alloc( jpi, jpj, zwf ) 145 ! 144 146 REWIND( numnam ) ! Namelist namlbc : lateral momentum boundary condition 145 147 READ ( numnam, namlbc ) … … 440 442 ENDIF 441 443 ! 442 IF( wrk_not_released(2, 1) .OR. & 443 iwrk_not_released(2, 1) ) CALL ctl_stop('dom_msk: failed to release workspace arrays') 444 CALL wrk_dealloc( jpi, jpj, imsk ) 445 CALL wrk_dealloc( jpi, jpj, zwf ) 446 ! 447 IF( nn_timing == 1 ) CALL timing_stop('dom_msk') 444 448 ! 445 449 END SUBROUTINE dom_msk … … 464 468 REAL(wp) :: zaa 465 469 !!--------------------------------------------------------------------- 466 470 ! 471 IF( nn_timing == 1 ) CALL timing_start('dom_msk_nsa') 472 ! 467 473 IF(lwp) WRITE(numout,*) 468 474 IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' … … 624 630 ENDIF 625 631 ! 632 IF( nn_timing == 1 ) CALL timing_stop('dom_msk_nsa') 633 ! 626 634 END SUBROUTINE dom_msk_nsa 627 635 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r2715 r3162 12 12 USE dom_oce ! ocean space and time domain 13 13 USE lib_mpp ! for mppsum 14 USE wrk_nemo_2 ! Memory allocation 15 USE timing ! Timing 16 14 17 15 18 IMPLICIT NONE … … 34 37 !! -> not good if located at too high latitude... 35 38 !!---------------------------------------------------------------------- 36 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released37 USE wrk_nemo, ONLY: zglam => wrk_2d_2 , zgphi => wrk_2d_3 , zmask => wrk_2d_4 , zdist => wrk_2d_538 39 ! 39 40 REAL(wp) , INTENT(in ) :: plon, plat ! longitude,latitude of the point … … 43 44 INTEGER , DIMENSION(2) :: iloc 44 45 REAL(wp) :: zlon, zmini 46 REAL(wp), POINTER, DIMENSION(:,:) :: zglam, zgphi, zmask, zdist 45 47 !!-------------------------------------------------------------------- 46 48 ! 47 IF( wrk_in_use(2, 2,3,4,5) ) CALL ctl_stop('dom_ngb: Requested workspaces already in use') 49 IF( nn_timing == 1 ) CALL timing_start('dom_ngb') 50 ! 51 CALL wrk_alloc( jpi, jpj, zglam, zgphi, zmask, zdist ) 48 52 ! 49 53 zmask(:,:) = 0._wp … … 72 76 ENDIF 73 77 ! 74 IF( wrk_not_released(2, 2,3,4,5) ) CALL ctl_stop('dom_ngb: error releasing workspaces') 78 CALL wrk_dealloc( jpi, jpj, zglam, zgphi, zmask, zdist ) 79 ! 80 IF( nn_timing == 1 ) CALL timing_stop('dom_ngb') 75 81 ! 76 82 END SUBROUTINE dom_ngb -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r3116 r3162 20 20 USE lib_mpp ! distributed memory computing library 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 USE wrk_nemo_2 ! Memory allocation 23 USE timing ! Timing 22 24 23 25 IMPLICIT NONE … … 66 68 !! (also f-point in now case) 67 69 !!---------------------------------------------------------------------- 68 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released69 USE wrk_nemo, ONLY: zee_t => wrk_2d_1, zee_u => wrk_2d_2, zee_v => wrk_2d_3, zee_f => wrk_2d_4 ! 2D workspace70 70 ! 71 71 INTEGER :: ji, jj, jk ! dummy loop indices 72 72 REAL(wp) :: zcoefu, zcoefv , zcoeff ! local scalars 73 73 REAL(wp) :: zvt , zvt_ip1, zvt_jp1, zvt_ip1jp1 ! - - 74 !!---------------------------------------------------------------------- 75 76 IF( wrk_in_use(2, 1,2,3,4) ) THEN 77 CALL ctl_stop('dom_vvl: requested workspace arrays unavailable') ; RETURN 78 ENDIF 79 74 REAL(wp), POINTER, DIMENSION(:,:) :: zee_t, zee_u, zee_v, zee_f ! 2D workspace 75 !!---------------------------------------------------------------------- 76 ! 77 IF( nn_timing == 1 ) CALL timing_start('dom_vvl') 78 ! 79 CALL wrk_alloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f ) 80 ! 80 81 IF(lwp) THEN 81 82 WRITE(numout,*) … … 165 166 CALL lbc_lnk( sshf_n, 'F', 1. ) 166 167 ! 167 IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('dom_vvl: failed to release workspace arrays') 168 CALL wrk_dealloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f ) 169 ! 170 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl') 168 171 ! 169 172 END SUBROUTINE dom_vvl … … 191 194 REAL(wp) :: zvt ! local scalars 192 195 !!---------------------------------------------------------------------- 193 196 ! 197 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_2') 198 ! 194 199 IF( lwp .AND. kt == nit000 ) THEN 195 200 WRITE(numout,*) … … 456 461 pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:) 457 462 ! 463 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_2') 464 ! 458 465 END SUBROUTINE dom_vvl_2 459 466 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r2715 r3162 20 20 USE lbclnk ! lateral boundary conditions - mpp exchanges 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo_2 ! Memory allocation 23 USE timing ! Timing 22 24 23 25 IMPLICIT NONE … … 63 65 !! masks, depth and vertical scale factors 64 66 !!---------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released66 USE wrk_nemo, ONLY: zprt => wrk_2d_1 , zprw => wrk_2d_2 ! 2D workspace67 USE wrk_nemo, ONLY: zdepu => wrk_3d_1 , zdepv => wrk_3d_2 ! 3D -68 67 !! 69 68 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file … … 78 77 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 79 78 INTEGER :: ji, jj, jk ! dummy loop indices 80 !!---------------------------------------------------------------------- 81 82 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2) )THEN 83 CALL ctl_stop('dom_wri: requested workspace arrays unavailable') ; RETURN 84 END IF 85 79 ! ! workspaces 80 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 82 !!---------------------------------------------------------------------- 83 ! 84 IF( nn_timing == 1 ) CALL timing_start('dom_wri') 85 ! 86 CALL wrk_alloc( jpi, jpj, zprt, zprw ) 87 CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv ) 88 ! 86 89 IF(lwp) WRITE(numout,*) 87 90 IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' … … 260 263 END SELECT 261 264 ! 262 IF( wrk_not_released(2, 1,2) .OR. & 263 wrk_not_released(3, 1,2) ) CALL ctl_stop('dom_wri: failed to release workspace arrays') 265 CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 266 CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv ) 267 ! 268 IF( nn_timing == 1 ) CALL timing_stop('dom_wri') 264 269 ! 265 270 END SUBROUTINE dom_wri … … 275 280 !! 2) check which elements have been changed 276 281 !!---------------------------------------------------------------------- 277 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released278 USE wrk_nemo, ONLY: ztstref => wrk_2d_3 ! array with different values for each element279 282 ! 280 283 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! … … 284 287 INTEGER :: ji ! dummy loop indices 285 288 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 286 !!---------------------------------------------------------------------- 287 288 IF( wrk_in_use(2, 3) ) THEN 289 CALL ctl_stop('dom_uniq: requested workspace array unavailable') ; RETURN 290 ENDIF 291 289 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 290 !!---------------------------------------------------------------------- 291 ! 292 IF( nn_timing == 1 ) CALL timing_start('dom_uniq') 293 ! 294 CALL wrk_alloc( jpi, jpj, ztstref ) 295 ! 292 296 ! build an array with different values for each element 293 297 ! in mpp: make sure that these values are different even between process … … 304 308 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 305 309 ! 306 IF( wrk_not_released(2, 3) ) CALL ctl_stop('dom_uniq: failed to release workspace array') 310 CALL wrk_alloc( jpi, jpj, ztstref ) 311 ! 312 IF( nn_timing == 1 ) CALL timing_stop('dom_uniq') 307 313 ! 308 314 END SUBROUTINE dom_uniq -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3116 r3162 38 38 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 39 39 USE lib_mpp ! distributed memory computing library 40 USE wrk_nemo_2 ! Memory allocation 41 USE timing ! Timing 40 42 41 43 IMPLICIT NONE … … 86 88 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 87 89 !!---------------------------------------------------------------------- 88 90 ! 91 IF( nn_timing == 1 ) CALL timing_start('dom_zgr') 92 ! 89 93 REWIND( numnam ) ! Read Namelist namzgr : vertical coordinate' 90 94 READ ( numnam, namzgr ) … … 139 143 ENDIF 140 144 ! 145 IF( nn_timing == 1 ) CALL timing_stop('dom_zgr') 146 ! 141 147 END SUBROUTINE dom_zgr 142 148 … … 170 176 REAL(wp) :: za2, zkth2, zacr2 ! Values for optional double tanh function set from parameters 171 177 !!---------------------------------------------------------------------- 172 178 ! 179 IF( nn_timing == 1 ) CALL timing_start('zgr_z') 180 ! 173 181 ! Set variables from parameters 174 182 ! ------------------------------ … … 280 288 END DO 281 289 ! 290 IF( nn_timing == 1 ) CALL timing_stop('zgr_z') 291 ! 282 292 END SUBROUTINE zgr_z 283 293 … … 319 329 REAL(wp) :: r_bump , h_bump , h_oce ! bump characteristics 320 330 REAL(wp) :: zi, zj, zh, zhmin ! local scalars 321 INTEGER , DIMENSION(jpidta,jpjdta) :: idta ! global domain integer data 322 REAL(wp), DIMENSION(jpidta,jpjdta) :: zdta ! global domain scalar data 323 !!---------------------------------------------------------------------- 324 331 INTEGER , POINTER, DIMENSION(:,:) :: idta ! global domain integer data 332 REAL(wp), POINTER, DIMENSION(:,:) :: zdta ! global domain scalar data 333 !!---------------------------------------------------------------------- 334 ! 335 IF( nn_timing == 1 ) CALL timing_start('zgr_bat') 336 ! 337 CALL wrk_alloc( jpidta, jpjdta, idta ) 338 CALL wrk_alloc( jpidta, jpjdta, zdta ) 339 ! 325 340 IF(lwp) WRITE(numout,*) 326 341 IF(lwp) WRITE(numout,*) ' zgr_bat : defines level and meter bathymetry' … … 512 527 ENDIF 513 528 ! 529 CALL wrk_dealloc( jpidta, jpjdta, idta ) 530 CALL wrk_dealloc( jpidta, jpjdta, zdta ) 531 ! 532 IF( nn_timing == 1 ) CALL timing_stop('zgr_bat') 533 ! 514 534 END SUBROUTINE zgr_bat 515 535 … … 589 609 !! - update bathy : meter bathymetry (in meters) 590 610 !!---------------------------------------------------------------------- 591 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released592 USE wrk_nemo, ONLY: zbathy => wrk_2d_1593 611 !! 594 612 INTEGER :: ji, jj, jl ! dummy loop indices 595 613 INTEGER :: icompt, ibtest, ikmax ! temporary integers 596 !!---------------------------------------------------------------------- 597 598 IF( wrk_in_use(2, 1) ) THEN 599 CALL ctl_stop('zgr_bat_ctl: requested workspace array unavailable') ; RETURN 600 ENDIF 601 614 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 615 !!---------------------------------------------------------------------- 616 ! 617 IF( nn_timing == 1 ) CALL timing_start('zgr_bat_ctl') 618 ! 619 CALL wrk_alloc( jpi, jpj, zbathy ) 620 ! 602 621 IF(lwp) WRITE(numout,*) 603 622 IF(lwp) WRITE(numout,*) ' zgr_bat_ctl : check the bathymetry' … … 702 721 ENDIF 703 722 ! 704 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 723 CALL wrk_dealloc( jpi, jpj, zbathy ) 724 ! 725 IF( nn_timing == 1 ) CALL timing_stop('zgr_bat_ctl') 705 726 ! 706 727 END SUBROUTINE zgr_bat_ctl … … 719 740 !! (min value = 1 over land) 720 741 !!---------------------------------------------------------------------- 721 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released722 USE wrk_nemo, ONLY: zmbk => wrk_2d_1723 742 !! 724 743 INTEGER :: ji, jj ! dummy loop indices 725 !!---------------------------------------------------------------------- 726 ! 727 IF( wrk_in_use(2, 1) ) THEN 728 CALL ctl_stop('zgr_bot_level: requested 2D workspace unavailable') ; RETURN 729 ENDIF 744 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 745 !!---------------------------------------------------------------------- 746 ! 747 IF( nn_timing == 1 ) CALL timing_start('zgr_bot_level') 748 ! 749 CALL wrk_alloc( jpi, jpj, zmbk ) 730 750 ! 731 751 IF(lwp) WRITE(numout,*) … … 745 765 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 746 766 ! 747 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bot_level: failed to release workspace array') 767 CALL wrk_dealloc( jpi, jpj, zmbk ) 768 ! 769 IF( nn_timing == 1 ) CALL timing_stop('zgr_bot_level') 748 770 ! 749 771 END SUBROUTINE zgr_bot_level … … 760 782 INTEGER :: jk 761 783 !!---------------------------------------------------------------------- 784 ! 785 IF( nn_timing == 1 ) CALL timing_start('zgr_zco') 762 786 ! 763 787 DO jk = 1, jpk … … 774 798 END DO 775 799 ! 800 IF( nn_timing == 1 ) CALL timing_stop('zgr_zco') 801 ! 776 802 END SUBROUTINE zgr_zco 777 803 … … 822 848 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 823 849 !!---------------------------------------------------------------------- 824 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released825 USE wrk_nemo, ONLY: zprt => wrk_3d_1826 850 !! 827 851 INTEGER :: ji, jj, jk ! dummy loop indices … … 833 857 REAL(wp) :: zdiff ! temporary scalar 834 858 REAL(wp) :: zrefdep ! temporary scalar 859 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt 835 860 !!--------------------------------------------------------------------- 836 ! 837 IF( wrk_in_use(3, 1) ) THEN838 CALL ctl_stop('zgr_zps: requested workspace unavailable.') ; RETURN839 ENDIF840 861 ! 862 IF( nn_timing == 1 ) CALL timing_start('zgr_zps') 863 ! 864 CALL wrk_alloc( jpi, jpj, jpk, zprt ) 865 ! 841 866 IF(lwp) WRITE(numout,*) 842 867 IF(lwp) WRITE(numout,*) ' zgr_zps : z-coordinate with partial steps' … … 1028 1053 ENDIF 1029 1054 ! 1030 IF( wrk_not_released(3, 1) ) CALL ctl_stop('zgr_zps: failed to release workspace') 1055 CALL wrk_dealloc( jpi, jpj, jpk, zprt ) 1056 ! 1057 IF( nn_timing == 1 ) CALL timing_stop('zgr_zps') 1031 1058 ! 1032 1059 END SUBROUTINE zgr_zps … … 1116 1143 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1117 1144 !!---------------------------------------------------------------------- 1118 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released1119 USE wrk_nemo, ONLY: zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk => wrk_2d_31120 USE wrk_nemo, ONLY: zri => wrk_2d_4 , zrj => wrk_2d_5 , zhbat => wrk_2d_61121 USE wrk_nemo, ONLY: gsigw3 => wrk_3d_11122 USE wrk_nemo, ONLY: gsigt3 => wrk_3d_21123 USE wrk_nemo, ONLY: gsi3w3 => wrk_3d_31124 USE wrk_nemo, ONLY: esigt3 => wrk_3d_41125 USE wrk_nemo, ONLY: esigw3 => wrk_3d_51126 USE wrk_nemo, ONLY: esigtu3 => wrk_3d_61127 USE wrk_nemo, ONLY: esigtv3 => wrk_3d_71128 USE wrk_nemo, ONLY: esigtf3 => wrk_3d_81129 USE wrk_nemo, ONLY: esigwu3 => wrk_3d_91130 USE wrk_nemo, ONLY: esigwv3 => wrk_3d_101131 1145 ! 1132 1146 INTEGER :: ji, jj, jk, jl ! dummy loop argument … … 1134 1148 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1135 1149 ! 1150 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1151 REAL(wp), POINTER, DIMENSION(:,:,:) :: gsigw3, gsigt3, gsi3w3 1152 REAL(wp), POINTER, DIMENSION(:,:,:) :: esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 1136 1153 1137 1154 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1138 1155 !!---------------------------------------------------------------------- 1139 1140 IF( wrk_in_use(2, 1,2,3,4,5,6) .OR. wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10) ) THEN 1141 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') ; RETURN 1142 ENDIF 1143 1156 ! 1157 IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1158 ! 1159 CALL wrk_alloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1160 CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3 ) 1161 CALL wrk_alloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 ) 1162 ! 1144 1163 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1145 1164 READ ( numnam, namzgr_sco ) … … 1598 1617 !!gm bug #endif 1599 1618 ! 1600 IF( wrk_not_released(2, 1,2,3,4,5,6) .OR. wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10) ) & 1601 & CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 1619 CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1620 CALL wrk_dealloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3 ) 1621 CALL wrk_dealloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 ) 1622 ! 1623 IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') 1602 1624 ! 1603 1625 END SUBROUTINE zgr_sco -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r3132 r3162 21 21 USE phycst ! physical constants 22 22 USE lib_mpp ! MPP library 23 USE wrk_nemo_2 ! Memory allocation 24 USE timing ! Timing 23 25 24 26 IMPLICIT NONE … … 61 63 NAMELIST/namtsd/ ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 62 64 !!---------------------------------------------------------------------- 63 65 ! 66 IF( nn_timing == 1 ) CALL timing_start('dta_tsd_init') 67 ! 64 68 ! ! set default namelist values 65 69 cn_dir = './' ! directory in which the model is executed … … 116 120 ! 117 121 ENDIF 122 ! 123 IF( nn_timing == 1 ) CALL timing_stop('dta_tsd_init') 118 124 ! 119 125 END SUBROUTINE dta_tsd_init … … 141 147 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 142 148 REAL(wp):: zl, zi 143 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 144 !!---------------------------------------------------------------------- 149 REAL(wp), POINTER, DIMENSION(:) :: ztp, zsp ! 1D workspace 150 !!---------------------------------------------------------------------- 151 ! 152 IF( nn_timing == 1 ) CALL timing_start('dta_tsd') 145 153 ! 146 154 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! … … 200 208 ! 201 209 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 210 ! 211 CALL wrk_alloc( jpk, ztp, zsp ) 202 212 ! 203 213 IF( kt == nit000 .AND. lwp )THEN … … 235 245 END DO 236 246 ! 247 CALL wrk_dealloc( jpk, ztp, zsp ) 248 ! 237 249 ELSE !== z- or zps- coordinate ==! 238 250 ! … … 286 298 ENDIF 287 299 ! 300 IF( nn_timing == 1 ) CALL timing_stop('dta_tsd') 301 ! 288 302 END SUBROUTINE dta_tsd 289 303 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r3116 r3162 43 43 USE dynspg_ts ! pressure gradient schemes 44 44 USE lib_mpp ! MPP library 45 USE wrk_nemo_2 ! Memory allocation 46 USE timing ! Timing 45 47 46 48 IMPLICIT NONE … … 67 69 ! - ML - needed for initialization of e3t_b 68 70 INTEGER :: jk ! dummy loop indice 71 !!---------------------------------------------------------------------- 72 ! 73 IF( nn_timing == 1 ) CALL timing_start('istate_init') 74 ! 69 75 70 76 IF(lwp) WRITE(numout,*) … … 137 143 ENDIF 138 144 ! 145 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 146 ! 139 147 END SUBROUTINE istate_init 140 148 … … 406 414 !! p=integral [ rau*g dz ] 407 415 !!---------------------------------------------------------------------- 408 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released409 USE wrk_nemo, ONLY: zprn => wrk_3d_1 ! 3D workspace410 411 416 USE dynspg ! surface pressure gradient (dyn_spg routine) 412 417 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) … … 416 421 INTEGER :: indic ! ??? 417 422 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 418 !!---------------------------------------------------------------------- 419 420 IF(wrk_in_use(3, 1) ) THEN 421 CALL ctl_stop('istate_uvg: requested workspace array unavailable') ; RETURN 422 ENDIF 423 423 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn 424 !!---------------------------------------------------------------------- 425 ! 426 CALL wrk_alloc( jpi, jpj, jpk, zprn) 427 ! 424 428 IF(lwp) WRITE(numout,*) 425 429 IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy' … … 517 521 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 518 522 ! 519 IF( wrk_not_released(3, 1) ) THEN 520 CALL ctl_stop('istate_uvg: failed to release workspace array') 521 ENDIF 523 CALL wrk_dealloc( jpi, jpj, jpk, zprn) 522 524 ! 523 525 END SUBROUTINE istate_uvg -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r2715 r3162 31 31 USE lib_mpp ! distributed memory computing 32 32 USE in_out_manager ! I/O manager 33 USE timing ! timing 33 34 34 35 IMPLICIT NONE … … 64 65 REAL(wp) :: z2dt, zcoef 65 66 !!---------------------------------------------------------------------- 66 67 ! 68 IF( nn_timing == 1 ) CALL timing_start('sol_mat') 69 ! 67 70 68 71 ! 1. Construction of the matrix … … 297 300 gccd (:,:) = 0.e0 298 301 ! 302 IF( nn_timing == 1 ) CALL timing_stop('sol_mat') 303 ! 299 304 END SUBROUTINE sol_mat 300 305 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90
r2715 r3162 14 14 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 15 15 USE in_out_manager ! I/O manager 16 USE lib_fortran 16 USE lib_fortran ! Fortran routines library 17 USE wrk_nemo_2 ! Memory allocation 18 USE timing ! Timing 17 19 18 20 IMPLICIT NONE … … 83 85 !! ! 08-01 (R. Benshila) mpp optimization 84 86 !!---------------------------------------------------------------------- 85 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released86 USE wrk_nemo, ONLY: zgcr => wrk_2d_187 87 !! 88 88 INTEGER, INTENT(inout) :: kindic ! solver indicator, < 0 if the conver- … … 93 93 REAL(wp) :: zgcad ! temporary scalars 94 94 REAL(wp), DIMENSION(2) :: zsum 95 REAL(wp), POINTER, DIMENSION(:,:) :: zgcr 95 96 !!---------------------------------------------------------------------- 96 97 IF( wrk_in_use(2, 1) )THEN98 CALL ctl_stop('sol_pcg: requested workspace array is unavailable') ; RETURN99 ENDIF100 97 ! 98 IF( nn_timing == 1 ) CALL timing_start('sol_pcg') 99 ! 100 CALL wrk_alloc( jpi, jpj, zgcr ) 101 ! 101 102 ! Initialization of the algorithm with standard PCG 102 103 ! ------------------------------------------------- … … 209 210 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! Output in gcx with lateral b.c. applied 210 211 ! 211 IF( wrk_not_released(2, 1) ) CALL ctl_stop('sol_pcg: failed to release workspace array') 212 CALL wrk_dealloc( jpi, jpj, zgcr ) 213 ! 214 IF( nn_timing == 1 ) CALL timing_stop('sol_pcg') 212 215 ! 213 216 END SUBROUTINE sol_pcg -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
r2715 r3162 22 22 USE lib_mpp ! distributed memory computing 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE lib_fortran 24 USE lib_fortran ! Fortran routines library 25 USE wrk_nemo_2 ! Memory allocation 26 USE timing ! Timing 25 27 26 28 IMPLICIT NONE … … 57 59 !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 58 60 !!---------------------------------------------------------------------- 59 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released60 USE wrk_nemo, ONLY: ztab => wrk_2d_1 ! 2D workspace61 61 !! 62 62 INTEGER, INTENT(inout) :: kindic ! solver indicator, < 0 if the convergence is not reached: … … 66 66 INTEGER :: ishift, icount, ijmppodd, ijmppeven, ijpr2d ! local integers 67 67 REAL(wp) :: ztmp, zres, zres2 ! local scalars 68 REAL(wp), POINTER, DIMENSION(:,:) :: ztab ! 2D workspace 68 69 !!---------------------------------------------------------------------- 69 70 IF( wrk_in_use(2, 1) )THEN71 CALL ctl_stop('sol_sor: requested workspace array is unavailable') ; RETURN72 ENDIF73 70 ! 71 IF( nn_timing == 1 ) CALL timing_start('sol_sor') 72 ! 73 CALL wrk_alloc( jpi, jpj, ztab ) 74 ! 74 75 ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj , 2 ) 75 76 ijmppodd = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) … … 167 168 ! ------------- 168 169 CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! boundary conditions 169 ! 170 IF( wrk_not_released(2, 1) ) CALL ctl_stop('sol_sor: failed to release workspace array') 170 ! 171 CALL wrk_dealloc( jpi, jpj, ztab ) 172 ! 173 IF( nn_timing == 1 ) CALL timing_stop('sol_sor') 171 174 ! 172 175 END SUBROUTINE sol_sor -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
r3116 r3162 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 27 USE lib_mpp ! MPP library 28 USE timing ! timing 28 29 29 30 IMPLICIT NONE … … 53 54 NAMELIST/namsol/ nn_solv, nn_sol_arp, nn_nmin, nn_nmax, nn_nmod, rn_eps, rn_resmax, rn_sor 54 55 !!---------------------------------------------------------------------- 56 ! 57 IF( nn_timing == 1 ) CALL timing_start('solver_init') 58 ! 55 59 56 60 IF(lwp) THEN !* open elliptic solver statistics file (only on the printing processors) … … 110 114 CALL sol_mat( kt ) !* Construction of the elliptic system matrix 111 115 ! 116 IF( nn_timing == 1 ) CALL timing_stop('solver_init') 117 ! 112 118 END SUBROUTINE solver_init 113 119 #endif
Note: See TracChangeset
for help on using the changeset viewer.
