Changeset 11129 for NEMO/branches/2019/ENHANCE-03_domcfg/src/domzgr.F90
- Timestamp:
- 2019-06-18T17:11:36+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/ENHANCE-03_domcfg
- Files:
-
- 1 edited
- 1 copied
-
. (copied) (copied from utils/tools_AGRIF_CMEMS_2020/DOMAINcfg)
-
src/domzgr.F90 (modified) (64 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-03_domcfg/src/domzgr.F90
r10727 r11129 35 35 !! fgamma : Siddorn and Furner 2012 stretching function 36 36 !!--------------------------------------------------------------------- 37 USE oce ! ocean variables38 37 USE dom_oce ! ocean domain 39 38 ! USE closea ! closed seas … … 43 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 43 USE lib_mpp ! distributed memory computing library 45 USE wrk_nemo ! Memory allocation 46 USE timing ! Timing 44 USE lib_fortran 47 45 USE dombat 48 46 … … 63 61 REAL(wp), PUBLIC :: e3zps_min !: miminum thickness for partial steps (meters) 64 62 REAL(wp), PUBLIC :: e3zps_rat !: minimum thickness ration for partial steps 65 INTEGER, PUBLIC :: nperio!: type of lateral boundary condition63 INTEGER, PUBLIC :: nperio !: type of lateral boundary condition 66 64 67 65 ! Song and Haidvogel 1994 stretching parameters … … 121 119 !!---------------------------------------------------------------------- 122 120 ! 123 ! IF( nn_timing == 1 ) CALL timing_start('dom_zgr')124 121 ! 125 122 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate … … 189 186 ENDIF 190 187 ! 191 ! IF( nn_timing == 1 ) CALL timing_stop('dom_zgr')192 !193 188 END SUBROUTINE dom_zgr 194 189 … … 222 217 REAL(wp) :: za2, zkth2, zacr2 ! Values for optional double tanh function set from parameters 223 218 !!---------------------------------------------------------------------- 224 !225 ! IF( nn_timing == 1 ) CALL timing_start('zgr_z')226 219 ! 227 220 ! Set variables from parameters … … 355 348 END DO 356 349 ! 357 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_z')358 !359 350 END SUBROUTINE zgr_z 360 351 … … 401 392 !!---------------------------------------------------------------------- 402 393 ! 403 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bat')404 !405 394 IF(lwp) WRITE(numout,*) 406 395 IF(lwp) WRITE(numout,*) ' zgr_bat : defines level and meter bathymetry' … … 411 400 ! ! global domain level and meter bathymetry (idta,zdta) 412 401 ! 413 ALLOCATE( idta(jpi dta,jpjdta), STAT=ierror )402 ALLOCATE( idta(jpiglo,jpjglo), STAT=ierror ) 414 403 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' ) 415 ALLOCATE( zdta(jpi dta,jpjdta), STAT=ierror )404 ALLOCATE( zdta(jpiglo,jpjglo), STAT=ierror ) 416 405 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' ) 417 406 ! … … 439 428 IF(lwp) WRITE(numout,*) 440 429 IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump' 441 ii_bump = jpi dta/ 2 ! i-index of the bump center442 ij_bump = jpj dta/ 2 ! j-index of the bump center430 ii_bump = jpiglo / 2 ! i-index of the bump center 431 ij_bump = jpjglo / 2 ! j-index of the bump center 443 432 r_bump = 50000._wp ! bump radius (meters) 444 433 h_bump = 2700._wp ! bump height (meters) … … 450 439 IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters' 451 440 ! 452 DO jj = 1, jpj dta! zdta :453 DO ji = 1, jpi dta441 DO jj = 1, jpjglo ! zdta : 442 DO ji = 1, jpiglo 454 443 zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump 455 444 zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump … … 467 456 ENDIF 468 457 ENDIF 458 ! 469 459 ! ! set GLOBAL boundary conditions 470 ! ! Caution : idta on the global domain: use of jperio, not nperio471 460 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 472 461 idta( : , 1 ) = -1 ; zdta( : , 1 ) = -1._wp 473 idta( : ,jpj dta) = 0 ; zdta( : ,jpjdta) = 0._wp462 idta( : ,jpjglo) = 0 ; zdta( : ,jpjglo) = 0._wp 474 463 ELSEIF( jperio == 2 ) THEN 475 464 idta( : , 1 ) = idta( : , 3 ) ; zdta( : , 1 ) = zdta( : , 3 ) 476 idta( : ,jpj dta) = 0 ; zdta( : ,jpjdta) = 0._wp465 idta( : ,jpjglo) = 0 ; zdta( : ,jpjglo) = 0._wp 477 466 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0._wp 478 idta(jpi dta, : ) = 0 ; zdta(jpidta, : ) = 0._wp467 idta(jpiglo, : ) = 0 ; zdta(jpiglo, : ) = 0._wp 479 468 ELSE 480 469 ih = 0 ; zh = 0._wp 481 470 IF( ln_sco ) ih = jpkm1 ; IF( ln_sco ) zh = h_oce 482 471 idta( : , 1 ) = ih ; zdta( : , 1 ) = zh 483 idta( : ,jpj dta) = ih ; zdta( : ,jpjdta) = zh472 idta( : ,jpjglo) = ih ; zdta( : ,jpjglo) = zh 484 473 idta( 1 , : ) = ih ; zdta( 1 , : ) = zh 485 idta(jpi dta, : ) = ih ; zdta(jpidta, : ) = zh474 idta(jpiglo, : ) = ih ; zdta(jpiglo, : ) = zh 486 475 ENDIF 487 476 … … 646 635 ENDIF 647 636 ! 648 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_bat')649 !650 637 END SUBROUTINE zgr_bat 651 638 … … 727 714 INTEGER :: ji, jj, jl ! dummy loop indices 728 715 INTEGER :: icompt, ibtest, ikmax ! temporary integers 729 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 730 !!---------------------------------------------------------------------- 731 ! 732 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bat_ctl') 733 ! 734 CALL wrk_alloc( jpi, jpj, zbathy ) 716 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zbathy 717 !!---------------------------------------------------------------------- 718 ! 719 ALLOCATE(zbathy(jpi,jpj)) 735 720 ! 736 721 IF(lwp) WRITE(numout,*) … … 743 728 icompt = 0 744 729 DO jl = 1, 2 745 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN730 IF( l_Iperio ) THEN 746 731 mbathy( 1 ,:) = mbathy(jpim1,:) ! local domain is cyclic east-west 747 732 mbathy(jpi,:) = mbathy( 2 ,:) 748 733 ENDIF 734 zbathy(:,:) = FLOAT( mbathy(:,:) ) 735 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 736 mbathy(:,:) = INT( zbathy(:,:) ) 737 749 738 DO jj = 2, jpjm1 750 739 DO ji = 2, jpim1 … … 760 749 END DO 761 750 END DO 762 ! IF( lk_mpp ) CALL mpp_sum( icompt ) 751 752 IF( lk_mpp ) CALL mpp_sum( 'domzgr', icompt ) 763 753 IF( icompt == 0 ) THEN 764 754 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' … … 766 756 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 767 757 ENDIF 768 IF( lk_mpp ) THEN 769 770 CALL lbc_lnk( 'toto',zbathy, 'T', 1._wp )771 772 ENDIF 758 759 zbathy(:,:) = FLOAT( mbathy(:,:) ) 760 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 761 mbathy(:,:) = INT( zbathy(:,:) ) 762 773 763 ! ! East-west cyclic boundary conditions 774 IF( nperio == 0 ) THEN775 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio764 IF( jperio == 0 ) THEN 765 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: jperio = ', jperio 776 766 IF( lk_mpp ) THEN 777 767 IF( nbondi == -1 .OR. nbondi == 2 ) THEN … … 790 780 ENDIF 791 781 ENDIF 792 ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN793 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio782 ELSEIF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 783 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio 794 784 mbathy( 1 ,:) = mbathy(jpim1,:) 795 785 mbathy(jpi,:) = mbathy( 2 ,:) 796 ELSEIF( nperio == 2 ) THEN797 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: nperio = ', nperio786 ELSEIF( jperio == 2 ) THEN 787 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions on mbathy: jperio = ', jperio 798 788 ELSE 799 789 IF(lwp) WRITE(numout,*) ' e r r o r' 800 IF(lwp) WRITE(numout,*) ' parameter , nperio = ', nperio790 IF(lwp) WRITE(numout,*) ' parameter , jperio = ', jperio 801 791 ! STOP 'dom_mba' 802 792 ENDIF 793 803 794 ! Boundary condition on mbathy 804 795 IF( .NOT.lk_mpp ) THEN … … 806 797 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab 807 798 zbathy(:,:) = FLOAT( mbathy(:,:) ) 808 CALL lbc_lnk( ' toto',zbathy, 'T', 1._wp )799 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp ) 809 800 mbathy(:,:) = INT( zbathy(:,:) ) 810 801 ENDIF 802 811 803 ! Number of ocean level inferior or equal to jpkm1 812 ikmax = 0 813 DO jj = 1, jpj 814 DO ji = 1, jpi 815 ikmax = MAX( ikmax, mbathy(ji,jj) ) 816 END DO 817 END DO 818 !!gm !!! test to do: ikmax = MAX( mbathy(:,:) ) ??? 804 zbathy(:,:) = FLOAT( mbathy(:,:) ) 805 ikmax = glob_max( 'domzgr', zbathy(:,:) ) 806 819 807 IF( ikmax > jpkm1 ) THEN 820 808 IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' > jpk-1' … … 825 813 ENDIF 826 814 ! 827 CALL wrk_dealloc( jpi, jpj, zbathy ) 828 ! 829 !! IF( nn_timing == 1 ) CALL timing_stop('zgr_bat_ctl') 815 DEALLOCATE( zbathy ) 830 816 ! 831 817 END SUBROUTINE zgr_bat_ctl … … 845 831 !!---------------------------------------------------------------------- 846 832 INTEGER :: ji, jj ! dummy loop indices 847 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 848 !!---------------------------------------------------------------------- 849 ! 850 ! IF( nn_timing == 1 ) CALL timing_start('zgr_bot_level') 851 ! 852 CALL wrk_alloc( jpi, jpj, zmbk ) 833 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmbk 834 !!---------------------------------------------------------------------- 835 ! 836 ALLOCATE( zmbk(jpi,jpj) ) 853 837 ! 854 838 IF(lwp) WRITE(numout,*) … … 866 850 END DO 867 851 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 868 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk('toto',zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 869 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk('toto',zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 870 ! 871 CALL wrk_dealloc( jpi, jpj, zmbk ) 872 ! 873 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_bot_level') 852 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 853 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk('domzgr',zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 854 ! 855 DEALLOCATE( zmbk ) 874 856 ! 875 857 END SUBROUTINE zgr_bot_level … … 889 871 !!---------------------------------------------------------------------- 890 872 INTEGER :: ji, jj ! dummy loop indices 891 REAL(wp), POINTER, DIMENSION(:,:) :: zmik 892 !!---------------------------------------------------------------------- 893 ! 894 ! IF( nn_timing == 1 ) CALL timing_start('zgr_top_level') 895 ! 896 CALL wrk_alloc( jpi, jpj, zmik ) 873 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zmik 874 !!---------------------------------------------------------------------- 875 ! 876 ALLOCATE( zmik(jpi,jpj) ) 897 877 ! 898 878 IF(lwp) WRITE(numout,*) … … 911 891 912 892 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 913 zmik(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'U',1.) ; miku (:,:) = MAX( INT( zmik(:,:) ), 1 ) 914 zmik(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'V',1.) ; mikv (:,:) = MAX( INT( zmik(:,:) ), 1 ) 915 zmik(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk('toto',zmik,'F',1.) ; mikf (:,:) = MAX( INT( zmik(:,:) ), 1 ) 916 ! 917 CALL wrk_dealloc( jpi, jpj, zmik ) 918 ! 919 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_top_level') 893 zmik(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'U',1.) ; miku (:,:) = MAX( INT( zmik(:,:) ), 1 ) 894 zmik(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'V',1.) ; mikv (:,:) = MAX( INT( zmik(:,:) ), 1 ) 895 zmik(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk('domzgr',zmik,'F',1.) ; mikf (:,:) = MAX( INT( zmik(:,:) ), 1 ) 896 ! 897 DEALLOCATE( zmik ) 920 898 ! 921 899 END SUBROUTINE zgr_top_level … … 932 910 INTEGER :: jk 933 911 !!---------------------------------------------------------------------- 934 !935 ! IF( nn_timing == 1 ) CALL timing_start('zgr_zco')936 912 ! 937 913 DO jk = 1, jpk … … 948 924 END DO 949 925 ! 950 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_zco')951 !952 926 END SUBROUTINE zgr_zco 953 927 … … 1004 978 REAL(wp) :: zdiff ! temporary scalar 1005 979 REAL(wp) :: zmax ! temporary scalar 1006 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprt980 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zprt 1007 981 !!--------------------------------------------------------------------- 1008 982 ! 1009 ! IF( nn_timing == 1 ) CALL timing_start('zgr_zps') 1010 ! 1011 CALL wrk_alloc( jpi,jpj,jpk, zprt ) 983 ALLOCATE( zprt(jpi,jpj,jpk) ) 1012 984 ! 1013 985 IF(lwp) WRITE(numout,*) … … 1140 1112 END IF 1141 1113 1142 CALL lbc_lnk(' toto', e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk('toto', e3uw_0, 'U', 1._wp ) ! lateral boundary conditions1143 CALL lbc_lnk( 'toto',e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk('toto', e3vw_0, 'V', 1._wp )1114 CALL lbc_lnk('domzgr', e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk('domzgr', e3uw_0, 'U', 1._wp ) ! lateral boundary conditions 1115 CALL lbc_lnk('domzgr', e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp ) 1144 1116 ! 1145 1117 … … 1162 1134 END DO 1163 1135 END DO 1164 CALL lbc_lnk(' toto', e3f_0, 'F', 1._wp ) ! Lateral boundary conditions1136 CALL lbc_lnk('domzgr', e3f_0, 'F', 1._wp ) ! Lateral boundary conditions 1165 1137 ! 1166 1138 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) … … 1203 1175 END IF 1204 1176 ! 1205 CALL wrk_dealloc( jpi,jpj,jpk, zprt ) 1206 ! 1207 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_zps') 1177 DEALLOCATE( zprt ) 1208 1178 ! 1209 1179 END SUBROUTINE zgr_zps … … 1235 1205 REAL(wp) :: zdepwp ! Ajusted ocean depth to avoid too small e3t 1236 1206 REAL(wp) :: zdiff ! temporary scalar 1237 REAL(wp), POINTER, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 2D workspace (ISH)1238 INTEGER , POINTER, DIMENSION(:,:) :: zmbathy, zmisfdep ! 2D workspace (ISH)1207 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrisfdep, zbathy, zmask ! 2D workspace (ISH) 1208 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: zmbathy, zmisfdep ! 2D workspace (ISH) 1239 1209 !!--------------------------------------------------------------------- 1240 1210 ! 1241 !! IF( nn_timing == 1 ) CALL timing_start('zgr_isf') 1242 ! 1243 CALL wrk_alloc( jpi,jpj, zbathy, zmask, zrisfdep) 1244 CALL wrk_alloc( jpi,jpj, zmisfdep, zmbathy ) 1245 1211 ALLOCATE( zbathy(jpi,jpj), zmask(jpi,jpj), zrisfdep(jpi,jpj) ) 1212 ALLOCATE( zmisfdep(jpi,jpj), zmbathy(jpi,jpj) ) 1213 ! 1246 1214 ! (ISF) compute misfdep 1247 1215 WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ; misfdep(:,:) = 1 ! open water : set misfdep to 1 … … 1286 1254 IF( lk_mpp ) THEN 1287 1255 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1288 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1256 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1289 1257 misfdep(:,:) = INT( zbathy(:,:) ) 1290 1258 1291 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1292 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1259 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1260 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1293 1261 1294 1262 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1295 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1263 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1296 1264 mbathy(:,:) = INT( zbathy(:,:) ) 1297 1265 ENDIF … … 1407 1375 IF( lk_mpp ) THEN 1408 1376 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1409 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1377 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1410 1378 misfdep(:,:) = INT( zbathy(:,:) ) 1411 1379 1412 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1413 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1380 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1381 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1414 1382 1415 1383 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1416 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1384 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1417 1385 mbathy(:,:) = INT( zbathy(:,:) ) 1418 1386 ENDIF … … 1444 1412 IF( lk_mpp ) THEN 1445 1413 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1446 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1414 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1447 1415 misfdep(:,:) = INT( zbathy(:,:) ) 1448 1416 1449 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1450 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1417 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1418 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1451 1419 1452 1420 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1453 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1421 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1454 1422 mbathy(:,:) = INT( zbathy(:,:) ) 1455 1423 ENDIF … … 1481 1449 IF( lk_mpp ) THEN 1482 1450 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1483 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1451 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1484 1452 misfdep(:,:) = INT( zbathy(:,:) ) 1485 1453 1486 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1487 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1454 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1455 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1488 1456 1489 1457 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1490 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1458 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1491 1459 mbathy(:,:) = INT( zbathy(:,:) ) 1492 1460 ENDIF … … 1518 1486 IF( lk_mpp ) THEN 1519 1487 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1520 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1488 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1521 1489 misfdep(:,:) = INT( zbathy(:,:) ) 1522 1490 1523 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1524 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1491 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1492 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1525 1493 1526 1494 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1527 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1495 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1528 1496 mbathy(:,:) = INT( zbathy(:,:) ) 1529 1497 ENDIF … … 1555 1523 IF( lk_mpp ) THEN 1556 1524 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1557 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1525 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1558 1526 misfdep(:,:) = INT( zbathy(:,:) ) 1559 1527 1560 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1561 CALL lbc_lnk(' toto', bathy, 'T', 1. )1528 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1529 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1562 1530 1563 1531 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1564 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1532 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1565 1533 mbathy(:,:) = INT( zbathy(:,:) ) 1566 1534 ENDIF … … 1587 1555 IF( lk_mpp ) THEN 1588 1556 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1589 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1557 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1590 1558 misfdep(:,:) = INT( zbathy(:,:) ) 1591 1559 1592 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1593 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1560 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1561 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1594 1562 1595 1563 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1596 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1564 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1597 1565 mbathy(:,:) = INT( zbathy(:,:) ) 1598 1566 ENDIF … … 1623 1591 IF( lk_mpp ) THEN 1624 1592 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1625 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1593 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1626 1594 misfdep(:,:) = INT( zbathy(:,:) ) 1627 1595 1628 CALL lbc_lnk( ' toto',risfdep, 'T', 1. )1629 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1596 CALL lbc_lnk( 'domzgr',risfdep, 'T', 1. ) 1597 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1630 1598 1631 1599 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1632 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1600 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1633 1601 mbathy(:,:) = INT( zbathy(:,:) ) 1634 1602 ENDIF … … 1656 1624 IF( lk_mpp ) THEN 1657 1625 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1658 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1626 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1659 1627 misfdep(:,:) = INT( zbathy(:,:) ) 1660 1628 1661 CALL lbc_lnk( ' toto',risfdep, 'T', 1. )1662 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1629 CALL lbc_lnk( 'domzgr',risfdep, 'T', 1. ) 1630 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1663 1631 1664 1632 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1665 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1633 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1666 1634 mbathy(:,:) = INT( zbathy(:,:) ) 1667 1635 ENDIF … … 1676 1644 IF( lk_mpp ) THEN 1677 1645 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1678 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1646 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1679 1647 misfdep(:,:) = INT( zbathy(:,:) ) 1680 1648 1681 CALL lbc_lnk(' toto', risfdep, 'T', 1. )1682 CALL lbc_lnk(' toto', bathy, 'T', 1. )1649 CALL lbc_lnk('domzgr', risfdep, 'T', 1. ) 1650 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1683 1651 1684 1652 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1685 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1653 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1686 1654 mbathy(:,:) = INT( zbathy(:,:) ) 1687 1655 ENDIF … … 1696 1664 IF( lk_mpp ) THEN 1697 1665 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1698 CALL lbc_lnk(' toto', zbathy, 'T', 1. )1666 CALL lbc_lnk('domzgr', zbathy, 'T', 1. ) 1699 1667 misfdep(:,:) = INT( zbathy(:,:) ) 1700 1668 1701 CALL lbc_lnk(' toto', risfdep,'T', 1. )1702 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1669 CALL lbc_lnk('domzgr', risfdep,'T', 1. ) 1670 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1703 1671 1704 1672 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1705 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1673 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1706 1674 mbathy(:,:) = INT( zbathy(:,:) ) 1707 1675 ENDIF … … 1716 1684 IF( lk_mpp ) THEN 1717 1685 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1718 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1686 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1719 1687 misfdep(:,:) = INT( zbathy(:,:) ) 1720 1688 1721 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1722 CALL lbc_lnk(' toto', bathy, 'T', 1. )1689 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1690 CALL lbc_lnk('domzgr', bathy, 'T', 1. ) 1723 1691 1724 1692 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1725 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1693 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1726 1694 mbathy(:,:) = INT( zbathy(:,:) ) 1727 1695 ENDIF … … 1736 1704 IF( lk_mpp ) THEN 1737 1705 zbathy(:,:) = FLOAT( misfdep(:,:) ) 1738 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1706 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1739 1707 misfdep(:,:) = INT( zbathy(:,:) ) 1740 1708 1741 CALL lbc_lnk( ' toto',risfdep,'T', 1. )1742 CALL lbc_lnk( ' toto',bathy, 'T', 1. )1709 CALL lbc_lnk( 'domzgr',risfdep,'T', 1. ) 1710 CALL lbc_lnk( 'domzgr',bathy, 'T', 1. ) 1743 1711 1744 1712 zbathy(:,:) = FLOAT( mbathy(:,:) ) 1745 CALL lbc_lnk( ' toto',zbathy, 'T', 1. )1713 CALL lbc_lnk( 'domzgr',zbathy, 'T', 1. ) 1746 1714 mbathy(:,:) = INT( zbathy(:,:) ) 1747 1715 ENDIF … … 1877 1845 END DO 1878 1846 1879 CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 1880 CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 1881 ! 1882 ! IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1883 ! 1847 DEALLOCATE( zbathy, zmask, zrisfdep ) 1848 DEALLOCATE( zmisfdep, zmbathy ) 1849 ! 1884 1850 END SUBROUTINE zgr_isf 1885 1851 … … 1935 1901 REAL(wp) :: zrfact 1936 1902 ! 1937 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj21938 REAL(wp), POINTER, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat1903 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 1904 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 1939 1905 !! 1940 1906 NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & … … 1942 1908 !!---------------------------------------------------------------------- 1943 1909 ! 1944 !! IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1945 ! 1946 CALL wrk_alloc( jpi,jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 1910 ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) ) 1947 1911 ! 1948 1912 REWIND( numnam_ref ) ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters … … 2024 1988 2025 1989 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 2026 CALL lbc_lnk( ' toto',zenv, 'T', 1._wp, 'no0' )1990 CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' ) 2027 1991 ! 2028 1992 ! smooth the bathymetry (if required) … … 2088 2052 END DO 2089 2053 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 2090 CALL lbc_lnk( ' toto',zenv, 'T', 1._wp, 'no0' )2054 CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' ) 2091 2055 ! ! ================ ! 2092 2056 END DO ! End loop ! … … 2132 2096 ! Apply lateral boundary condition 2133 2097 !!gm ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL 2134 zhbat(:,:) = hbatu(:,:) ; CALL lbc_lnk(' toto', hbatu, 'U', 1._wp )2098 zhbat(:,:) = hbatu(:,:) ; CALL lbc_lnk('domzgr', hbatu, 'U', 1._wp ) 2135 2099 DO jj = 1, jpj 2136 2100 DO ji = 1, jpi … … 2142 2106 END DO 2143 2107 END DO 2144 zhbat(:,:) = hbatv(:,:) ; CALL lbc_lnk(' toto', hbatv, 'V', 1._wp )2108 zhbat(:,:) = hbatv(:,:) ; CALL lbc_lnk('domzgr', hbatv, 'V', 1._wp ) 2145 2109 DO jj = 1, jpj 2146 2110 DO ji = 1, jpi … … 2151 2115 END DO 2152 2116 END DO 2153 zhbat(:,:) = hbatf(:,:) ; CALL lbc_lnk(' toto', hbatf, 'F', 1._wp )2117 zhbat(:,:) = hbatf(:,:) ; CALL lbc_lnk('domzgr', hbatf, 'F', 1._wp ) 2154 2118 DO jj = 1, jpj 2155 2119 DO ji = 1, jpi … … 2199 2163 ENDIF 2200 2164 2201 CALL lbc_lnk( ' toto',e3t_0 , 'T', 1._wp )2202 CALL lbc_lnk( ' toto',e3u_0 , 'U', 1._wp )2203 CALL lbc_lnk( ' toto',e3v_0 , 'V', 1._wp )2204 CALL lbc_lnk( ' toto',e3f_0 , 'F', 1._wp )2205 CALL lbc_lnk( ' toto',e3w_0 , 'W', 1._wp )2206 CALL lbc_lnk( ' toto',e3uw_0, 'U', 1._wp )2207 CALL lbc_lnk(' toto', e3vw_0, 'V', 1._wp )2165 CALL lbc_lnk( 'domzgr',e3t_0 , 'T', 1._wp ) 2166 CALL lbc_lnk( 'domzgr',e3u_0 , 'U', 1._wp ) 2167 CALL lbc_lnk( 'domzgr',e3v_0 , 'V', 1._wp ) 2168 CALL lbc_lnk( 'domzgr',e3f_0 , 'F', 1._wp ) 2169 CALL lbc_lnk( 'domzgr',e3w_0 , 'W', 1._wp ) 2170 CALL lbc_lnk( 'domzgr',e3uw_0, 'U', 1._wp ) 2171 CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp ) 2208 2172 ! 2209 2173 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp … … 2214 2178 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2215 2179 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2216 2217 2218 !!gm I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays)2219 !!gm and only that !!!!!2220 !!gm THIS should be removed from here !2221 gdept_n(:,:,:) = gdept_0(:,:,:)2222 gdepw_n(:,:,:) = gdepw_0(:,:,:)2223 gde3w_n(:,:,:) = gde3w_0(:,:,:)2224 e3t_n (:,:,:) = e3t_0 (:,:,:)2225 e3u_n (:,:,:) = e3u_0 (:,:,:)2226 e3v_n (:,:,:) = e3v_0 (:,:,:)2227 e3f_n (:,:,:) = e3f_0 (:,:,:)2228 e3w_n (:,:,:) = e3w_0 (:,:,:)2229 e3uw_n (:,:,:) = e3uw_0 (:,:,:)2230 e3vw_n (:,:,:) = e3vw_0 (:,:,:)2231 !!gm and obviously in the following, use the _0 arrays until the end of this subroutine2232 !! gm end2233 2180 !! 2234 2181 ! HYBRID : … … 2236 2183 DO ji = 1, jpi 2237 2184 DO jk = 1, jpkm1 2238 IF( scobot(ji,jj) >= gdept_ n(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk )2185 IF( scobot(ji,jj) >= gdept_0(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 2239 2186 END DO 2240 2187 END DO … … 2298 2245 DO jk = 1, mbathy(ji,jj) 2299 2246 ! check coordinate is monotonically increasing 2300 IF (e3w_ n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN2247 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN 2301 2248 WRITE(ctmp1,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2302 2249 WRITE(numout,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2303 WRITE(numout,*) 'e3w',e3w_ n(ji,jj,:)2304 WRITE(numout,*) 'e3t',e3t_ n(ji,jj,:)2250 WRITE(numout,*) 'e3w',e3w_0(ji,jj,:) 2251 WRITE(numout,*) 'e3t',e3t_0(ji,jj,:) 2305 2252 CALL ctl_stop( ctmp1 ) 2306 2253 ENDIF 2307 2254 ! and check it has never gone negative 2308 IF( gdepw_ n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN2255 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN 2309 2256 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2310 2257 WRITE(numout,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2311 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2312 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2258 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2259 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2313 2260 CALL ctl_stop( ctmp1 ) 2314 2261 ENDIF 2315 2262 ! and check it never exceeds the total depth 2316 IF( gdepw_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2263 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2317 2264 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2318 2265 WRITE(numout,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2319 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2266 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2320 2267 CALL ctl_stop( ctmp1 ) 2321 2268 ENDIF … … 2324 2271 DO jk = 1, mbathy(ji,jj)-1 2325 2272 ! and check it never exceeds the total depth 2326 IF( gdept_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2273 IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2327 2274 WRITE(ctmp1,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2328 2275 WRITE(numout,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2329 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2276 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2330 2277 CALL ctl_stop( ctmp1 ) 2331 2278 ENDIF … … 2335 2282 END DO 2336 2283 ! 2337 CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 2338 ! 2339 !!! IF( nn_timing == 1 ) CALL timing_stop('zgr_sco') 2284 DEALLOCATE( zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 2340 2285 ! 2341 2286 END SUBROUTINE zgr_sco … … 2358 2303 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2359 2304 ! 2360 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2361 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2362 !!---------------------------------------------------------------------- 2363 2364 CALL wrk_alloc( jpi,jpj,jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2365 CALL wrk_alloc( jpi,jpj,jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2305 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2306 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2307 !!---------------------------------------------------------------------- 2308 2309 ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk), z_gsi3w3 (jpi,jpj,jpk) ) 2310 ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk) ) 2311 ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) ) 2366 2312 2367 2313 z_gsigw3 = 0._wp ; z_gsigt3 = 0._wp ; z_gsi3w3 = 0._wp … … 2448 2394 END DO 2449 2395 ! 2450 CALL wrk_dealloc( jpi,jpj,jpk,z_gsigw3, z_gsigt3, z_gsi3w3 )2451 CALL wrk_dealloc( jpi,jpj,jpk,z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )2396 DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3 ) 2397 DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2452 2398 ! 2453 2399 END SUBROUTINE s_sh94 … … 2476 2422 REAL(wp) :: ztmpu1, ztmpv1, ztmpf1 2477 2423 ! 2478 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2479 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2480 !!---------------------------------------------------------------------- 2481 ! 2482 CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2483 CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2424 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2425 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2426 !!---------------------------------------------------------------------- 2427 ! 2428 ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk), z_gsi3w3 (jpi,jpj,jpk) ) 2429 ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk)) 2430 ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) ) 2484 2431 2485 2432 z_gsigw3 = 0._wp ; z_gsigt3 = 0._wp ; z_gsi3w3 = 0._wp … … 2608 2555 ENDDO 2609 2556 ! 2610 CALL lbc_lnk(' toto',e3t_0 ,'T',1.) ; CALL lbc_lnk('toto',e3u_0 ,'T',1.)2611 CALL lbc_lnk(' toto',e3v_0 ,'T',1.) ; CALL lbc_lnk('toto',e3f_0 ,'T',1.)2612 CALL lbc_lnk(' toto',e3w_0 ,'T',1.)2613 CALL lbc_lnk(' toto',e3uw_0,'T',1.) ; CALL lbc_lnk('toto',e3vw_0,'T',1.)2614 ! 2615 CALL wrk_dealloc( jpi,jpj,jpk,z_gsigw3, z_gsigt3, z_gsi3w3 )2616 CALL wrk_dealloc( jpi,jpj,jpk,z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )2557 CALL lbc_lnk('domzgr',e3t_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3u_0 ,'T',1.) 2558 CALL lbc_lnk('domzgr',e3v_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3f_0 ,'T',1.) 2559 CALL lbc_lnk('domzgr',e3w_0 ,'T',1.) 2560 CALL lbc_lnk('domzgr',e3uw_0,'T',1.) ; CALL lbc_lnk('domzgr',e3vw_0,'T',1.) 2561 ! 2562 DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3 ) 2563 DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2617 2564 ! 2618 2565 END SUBROUTINE s_sf12 … … 2631 2578 INTEGER :: ji, jj, jk ! dummy loop argument 2632 2579 REAL(wp) :: zcoeft, zcoefw ! temporary scalars 2633 REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w2634 REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw2635 !!---------------------------------------------------------------------- 2636 2637 CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w)2638 CALL wrk_alloc( jpk, z_esigt, z_esigw)2580 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 2581 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw 2582 !!---------------------------------------------------------------------- 2583 2584 ALLOCATE( z_gsigw(jpk), z_gsigt(jpk), z_gsi3w(jpk) ) 2585 ALLOCATE( z_esigt(jpk), z_esigw(jpk) ) 2639 2586 2640 2587 z_gsigw = 0._wp ; z_gsigt = 0._wp ; z_gsi3w = 0._wp … … 2686 2633 END DO 2687 2634 ! 2688 CALL wrk_dealloc( jpk,z_gsigw, z_gsigt, z_gsi3w )2689 CALL wrk_dealloc( jpk,z_esigt, z_esigw )2635 DEALLOCATE( z_gsigw, z_gsigt, z_gsi3w ) 2636 DEALLOCATE( z_esigt, z_esigw ) 2690 2637 ! 2691 2638 END SUBROUTINE s_tanh
Note: See TracChangeset
for help on using the changeset viewer.
