Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2950 r3294 38 38 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 39 39 USE lib_mpp ! distributed memory computing library 40 USE wrk_nemo ! 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' … … 440 455 CALL iom_close( inum ) 441 456 ! ! ===================== 442 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration443 ii0 = 51 ; ii1 = 53444 ij0 = 142 ; ij1 = 142 ! =====================445 DO ji = mi0(ii0), mi1(ii1) ! Close Halmera Strait446 DO jj = mj0(ij0), mj1(ij1)447 bathy(ji,jj) = 0._wp448 END DO449 END DO450 IF(lwp) WRITE(numout,*)451 IF(lwp) WRITE(numout,*) ' orca_r1: Halmera strait closed at i=',ii0,' j=',ij0,'->',ij1452 ENDIF453 ! ! =====================454 457 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 455 458 ! ! ===================== … … 512 515 ENDIF 513 516 ! 517 CALL wrk_dealloc( jpidta, jpjdta, idta ) 518 CALL wrk_dealloc( jpidta, jpjdta, zdta ) 519 ! 520 IF( nn_timing == 1 ) CALL timing_stop('zgr_bat') 521 ! 514 522 END SUBROUTINE zgr_bat 515 523 … … 589 597 !! - update bathy : meter bathymetry (in meters) 590 598 !!---------------------------------------------------------------------- 591 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released592 USE wrk_nemo, ONLY: zbathy => wrk_2d_1593 599 !! 594 600 INTEGER :: ji, jj, jl ! dummy loop indices 595 601 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 602 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 603 !!---------------------------------------------------------------------- 604 ! 605 IF( nn_timing == 1 ) CALL timing_start('zgr_bat_ctl') 606 ! 607 CALL wrk_alloc( jpi, jpj, zbathy ) 608 ! 602 609 IF(lwp) WRITE(numout,*) 603 610 IF(lwp) WRITE(numout,*) ' zgr_bat_ctl : check the bathymetry' … … 702 709 ENDIF 703 710 ! 704 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 711 CALL wrk_dealloc( jpi, jpj, zbathy ) 712 ! 713 IF( nn_timing == 1 ) CALL timing_stop('zgr_bat_ctl') 705 714 ! 706 715 END SUBROUTINE zgr_bat_ctl … … 719 728 !! (min value = 1 over land) 720 729 !!---------------------------------------------------------------------- 721 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released722 USE wrk_nemo, ONLY: zmbk => wrk_2d_1723 730 !! 724 731 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 732 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 733 !!---------------------------------------------------------------------- 734 ! 735 IF( nn_timing == 1 ) CALL timing_start('zgr_bot_level') 736 ! 737 CALL wrk_alloc( jpi, jpj, zmbk ) 730 738 ! 731 739 IF(lwp) WRITE(numout,*) … … 745 753 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 746 754 ! 747 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bot_level: failed to release workspace array') 755 CALL wrk_dealloc( jpi, jpj, zmbk ) 756 ! 757 IF( nn_timing == 1 ) CALL timing_stop('zgr_bot_level') 748 758 ! 749 759 END SUBROUTINE zgr_bot_level … … 761 771 !!---------------------------------------------------------------------- 762 772 ! 773 IF( nn_timing == 1 ) CALL timing_start('zgr_zco') 774 ! 763 775 DO jk = 1, jpk 764 fsdept(:,:,jk) = gdept_0(jk) 765 fsdepw(:,:,jk) = gdepw_0(jk) 766 fsde3w(:,:,jk) = gdepw_0(jk) 767 fse3t (:,:,jk) = e3t_0(jk) 768 fse3u (:,:,jk) = e3t_0(jk) 769 fse3v (:,:,jk) = e3t_0(jk) 770 fse3f (:,:,jk) = e3t_0(jk) 771 fse3w (:,:,jk) = e3w_0(jk) 772 fse3uw(:,:,jk) = e3w_0(jk) 773 fse3vw(:,:,jk) = e3w_0(jk) 774 END DO 776 gdept(:,:,jk) = gdept_0(jk) 777 gdepw(:,:,jk) = gdepw_0(jk) 778 gdep3w(:,:,jk) = gdepw_0(jk) 779 e3t (:,:,jk) = e3t_0(jk) 780 e3u (:,:,jk) = e3t_0(jk) 781 e3v (:,:,jk) = e3t_0(jk) 782 e3f (:,:,jk) = e3t_0(jk) 783 e3w (:,:,jk) = e3w_0(jk) 784 e3uw(:,:,jk) = e3w_0(jk) 785 e3vw(:,:,jk) = e3w_0(jk) 786 END DO 787 ! 788 IF( nn_timing == 1 ) CALL timing_stop('zgr_zco') 775 789 ! 776 790 END SUBROUTINE zgr_zco … … 822 836 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 823 837 !!---------------------------------------------------------------------- 824 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released825 USE wrk_nemo, ONLY: zprt => wrk_3d_1826 838 !! 827 839 INTEGER :: ji, jj, jk ! dummy loop indices … … 833 845 REAL(wp) :: zdiff ! temporary scalar 834 846 REAL(wp) :: zrefdep ! temporary scalar 847 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt 835 848 !!--------------------------------------------------------------------- 836 ! 837 IF( wrk_in_use(3, 1) ) THEN838 CALL ctl_stop('zgr_zps: requested workspace unavailable.') ; RETURN839 ENDIF840 849 ! 850 IF( nn_timing == 1 ) CALL timing_start('zgr_zps') 851 ! 852 CALL wrk_alloc( jpi, jpj, jpk, zprt ) 853 ! 841 854 IF(lwp) WRITE(numout,*) 842 855 IF(lwp) WRITE(numout,*) ' zgr_zps : z-coordinate with partial steps' … … 1017 1030 WRITE(numout,*) 'domzgr e3t(mbathy)' ; CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1018 1031 WRITE(numout,*) 1019 WRITE(numout,*) 'domzgr e3w(mbathy)' ; CALL prihre(zprt(:,:, 1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1032 WRITE(numout,*) 'domzgr e3w(mbathy)' ; CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1020 1033 WRITE(numout,*) 1021 WRITE(numout,*) 'domzgr e3u(mbathy)' ; CALL prihre(zprt(:,:, 1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1034 WRITE(numout,*) 'domzgr e3u(mbathy)' ; CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1022 1035 WRITE(numout,*) 1023 WRITE(numout,*) 'domzgr e3v(mbathy)' ; CALL prihre(zprt(:,:, 1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1036 WRITE(numout,*) 'domzgr e3v(mbathy)' ; CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1024 1037 WRITE(numout,*) 1025 WRITE(numout,*) 'domzgr e3f(mbathy)' ; CALL prihre(zprt(:,:, 1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1038 WRITE(numout,*) 'domzgr e3f(mbathy)' ; CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1026 1039 WRITE(numout,*) 1027 WRITE(numout,*) 'domzgr gdep3w(mbathy)' ; CALL prihre(zprt(:,:, 1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)1040 WRITE(numout,*) 'domzgr gdep3w(mbathy)' ; CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 1028 1041 ENDIF 1029 1042 ! 1030 IF( wrk_not_released(3, 1) ) CALL ctl_stop('zgr_zps: failed to release workspace') 1043 CALL wrk_dealloc( jpi, jpj, jpk, zprt ) 1044 ! 1045 IF( nn_timing == 1 ) CALL timing_stop('zgr_zps') 1031 1046 ! 1032 1047 END SUBROUTINE zgr_zps … … 1116 1131 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1117 1132 !!---------------------------------------------------------------------- 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 1133 ! 1132 1134 INTEGER :: ji, jj, jk, jl ! dummy loop argument … … 1134 1136 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1135 1137 ! 1138 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1139 REAL(wp), POINTER, DIMENSION(:,:,:) :: gsigw3, gsigt3, gsi3w3 1140 REAL(wp), POINTER, DIMENSION(:,:,:) :: esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 1136 1141 1137 1142 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1138 1143 !!---------------------------------------------------------------------- 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 1144 ! 1145 IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1146 ! 1147 CALL wrk_alloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1148 CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3 ) 1149 CALL wrk_alloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 ) 1150 ! 1144 1151 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1145 1152 READ ( numnam, namzgr_sco ) … … 1494 1501 1495 1502 ! 1496 !! H. Liu, POL. April 2009. Added for passing the scale check for the new released vvl code. 1503 where (e3t (:,:,:).eq.0.0) e3t(:,:,:) = 1.0 1504 where (e3u (:,:,:).eq.0.0) e3u(:,:,:) = 1.0 1505 where (e3v (:,:,:).eq.0.0) e3v(:,:,:) = 1.0 1506 where (e3f (:,:,:).eq.0.0) e3f(:,:,:) = 1.0 1507 where (e3w (:,:,:).eq.0.0) e3w(:,:,:) = 1.0 1508 where (e3uw (:,:,:).eq.0.0) e3uw(:,:,:) = 1.0 1509 where (e3vw (:,:,:).eq.0.0) e3vw(:,:,:) = 1.0 1510 1497 1511 1498 1512 fsdept(:,:,:) = gdept (:,:,:) … … 1590 1604 !!gm bug #endif 1591 1605 ! 1592 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) ) & 1593 & CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 1606 CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat ) 1607 CALL wrk_dealloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3 ) 1608 CALL wrk_dealloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 ) 1609 ! 1610 IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') 1594 1611 ! 1595 1612 END SUBROUTINE zgr_sco
Note: See TracChangeset
for help on using the changeset viewer.
