- Timestamp:
- 2015-09-13T09:42:41+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5504 r5737 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea 11 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 12 !!---------------------------------------------------------------------- 6 13 7 14 !!---------------------------------------------------------------------- … … 10 17 !! dom_ctl : control print for the ocean domain 11 18 !!---------------------------------------------------------------------- 12 !! * Modules used13 19 USE oce ! 20 USE trc_oce ! shared ocean/biogeochemical variables 14 21 USE dom_oce ! ocean space and time domain 15 22 USE phycst ! physical constants 23 USE domstp ! domain: set the time-step 24 ! 16 25 USE in_out_manager ! I/O manager 17 26 USE lib_mpp ! distributed memory computing library 18 19 USE domstp ! domain: set the time-step20 21 27 USE lbclnk ! lateral boundary condition - MPP exchanges 22 USE trc_oce ! shared ocean/biogeochemical variables23 28 USE wrk_nemo 24 29 … … 26 31 PRIVATE 27 32 28 !! * Routine accessibility 29 PUBLIC dom_rea ! called by opa.F90 33 PUBLIC dom_rea ! called by nemogcm.F90 30 34 31 35 !! * Substitutions … … 33 37 # include "vectopt_loop_substitute.h90" 34 38 !!---------------------------------------------------------------------- 35 !! NEMO/OFF 3. 3 , NEMO Consortium (2010)39 !! NEMO/OFF 3.7 , NEMO Consortium (2015) 36 40 !! $Id$ 37 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 42 !!---------------------------------------------------------------------- 39 40 43 CONTAINS 41 44 … … 51 54 !! - dom_stp: defined the model time step 52 55 !! - dom_rea: read the meshmask file if nmsh=1 53 !! 54 !! History : 55 !! ! 90-10 (C. Levy - G. Madec) Original code 56 !! ! 91-11 (G. Madec) 57 !! ! 92-01 (M. Imbard) insert time step initialization 58 !! ! 96-06 (G. Madec) generalized vertical coordinate 59 !! ! 97-02 (G. Madec) creation of domwri.F 60 !! ! 01-05 (E.Durand - G. Madec) insert closed sea 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 62 !!---------------------------------------------------------------------- 63 !! * Local declarations 64 INTEGER :: jk ! dummy loop argument 65 INTEGER :: iconf = 0 ! temporary integers 66 !!---------------------------------------------------------------------- 67 56 !!---------------------------------------------------------------------- 57 INTEGER :: jk ! dummy loop index 58 INTEGER :: iconf = 0 ! local integers 59 !!---------------------------------------------------------------------- 60 ! 68 61 IF(lwp) THEN 69 62 WRITE(numout,*) … … 71 64 WRITE(numout,*) '~~~~~~~~' 72 65 ENDIF 73 66 ! 74 67 CALL dom_nam ! read namelist ( namrun, namdom, namcla ) 75 68 CALL dom_zgr ! Vertical mesh and bathymetry option 76 69 CALL dom_grd ! Create a domain file 77 78 !79 ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines80 ! but could be usefull in many other routines81 e12t (:,:) = e1t(:,:) * e2t(:,:)82 e1e2t (:,:) = e1t(:,:) * e2t(:,:)83 e12u (:,:) = e1u(:,:) * e2u(:,:)84 e12v (:,:) = e1v(:,:) * e2v(:,:)85 e1 2f (:,:) = e1f(:,:) * e2f(:,:)86 r1_e12t (:,:) = 1._wp / e12t(:,:)87 r1_e12u (:,:) = 1._wp / e12u(:,:)88 r1_e12v (:,:) = 1._wp / e12v(:,:)89 r1_e12f (:,:) = 1._wp / e12f(:,:)90 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)91 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)92 ! 93 hu(:,:) = 0._wp 70 ! 71 ! ! associated horizontal metrics 72 ! 73 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 74 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 75 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 76 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 ! 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 80 e1e2v (:,:) = e1v(:,:) * e2v(:,:) ; r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 81 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 82 ! 83 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 ! 86 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 94 87 hv(:,:) = 0._wp 95 88 DO jk = 1, jpk … … 100 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 101 94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 102 95 ! 103 96 CALL dom_stp ! Time step 104 97 CALL dom_msk ! Masks 105 98 CALL dom_ctl ! Domain control 106 99 ! 107 100 END SUBROUTINE dom_rea 101 108 102 109 103 SUBROUTINE dom_nam … … 118 112 !!---------------------------------------------------------------------- 119 113 USE ioipsl 120 INTEGER :: ios ! Local integer output status for namelist read 114 INTEGER :: ios ! Local integer output status for namelist read 115 ! 121 116 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 122 117 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & … … 178 173 nstocklist = nn_stocklist 179 174 nwrite = nn_write 180 181 175 ! 182 176 ! ! control of output frequency 183 177 IF ( nstock == 0 .OR. nstock > nitend ) THEN … … 321 315 END SUBROUTINE dom_nam 322 316 317 323 318 SUBROUTINE dom_zgr 324 319 !!---------------------------------------------------------------------- … … 374 369 END SUBROUTINE dom_zgr 375 370 371 376 372 SUBROUTINE dom_ctl 377 373 !!---------------------------------------------------------------------- … … 382 378 !! ** Method : compute and print extrema of masked scale factors 383 379 !! 384 !! History : 385 !! 8.5 ! 02-08 (G. Madec) Original code 386 !!---------------------------------------------------------------------- 387 !! * Local declarations 380 !!---------------------------------------------------------------------- 388 381 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 389 382 INTEGER, DIMENSION(2) :: iloc ! … … 421 414 ijma2 = iloc(2) + njmpp - 1 422 415 ENDIF 423 416 ! 424 417 IF(lwp) THEN 425 418 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 … … 428 421 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 429 422 ENDIF 430 423 ! 431 424 END SUBROUTINE dom_ctl 425 432 426 433 427 SUBROUTINE dom_grd … … 538 532 CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 539 533 #endif 540 541 534 ! ! horizontal mesh (inum3) 542 535 CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) … … 756 749 !! (min value = 1 over land) 757 750 !!---------------------------------------------------------------------- 758 !759 751 INTEGER :: ji, jj ! dummy loop indices 760 752 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk … … 785 777 END SUBROUTINE zgr_bot_level 786 778 779 787 780 SUBROUTINE dom_msk 788 781 !!--------------------------------------------------------------------- … … 799 792 !! tpol : ??? 800 793 !!---------------------------------------------------------------------- 801 ! 802 INTEGER :: ji, jj, jk ! dummy loop indices 803 INTEGER :: iif, iil, ijf, ijl ! local integers 794 INTEGER :: ji, jj, jk ! dummy loop indices 795 INTEGER :: iif, iil, ijf, ijl ! local integers 804 796 INTEGER, POINTER, DIMENSION(:,:) :: imsk 805 !806 797 !!--------------------------------------------------------------------- 807 798 … … 853 844 ! 3. Ocean/land mask at wu-, wv- and w points 854 845 !---------------------------------------------- 855 wmask (:,:,1) = tmask(:,:,1) ! ????????856 wumask(:,:,1) = umask(:,:,1) ! ????????857 wvmask(:,:,1) = vmask(:,:,1) ! ????????858 DO jk =2,jpk859 wmask (:,:,jk) =tmask(:,:,jk) * tmask(:,:,jk-1)860 wumask(:,:,jk) =umask(:,:,jk) * umask(:,:,jk-1)861 wvmask(:,:,jk) =vmask(:,:,jk) * vmask(:,:,jk-1)846 wmask (:,:,1) = tmask(:,:,1) ! surface value 847 wumask(:,:,1) = umask(:,:,1) 848 wvmask(:,:,1) = vmask(:,:,1) 849 DO jk = 2, jpk ! deeper value 850 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 851 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 852 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 862 853 END DO 863 854 !
Note: See TracChangeset
for help on using the changeset viewer.