Changeset 12680
- Timestamp:
- 2020-04-03T18:54:55+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
- Files:
-
- 43 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90
r12679 r12680 60 60 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 61 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 ! 62 63 63 !! * Substitutions 64 64 # include "do_loop_substitute.h90" … … 102 102 REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 103 103 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini !data from namelist or nc file 104 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d ! temporaryarrays104 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !locak arrays 105 105 !! 106 106 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d … … 452 452 !! 453 453 !!----------------------------------------------------------------------------- 454 INTEGER :: ios ! Local integer output status for namelist read455 INTEGER :: ifpr, ierror 454 INTEGER :: ios, ifpr, ierror ! Local integers 455 456 456 ! 457 457 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90
r12656 r12680 9 9 !! ! 2007-04 (A. Weaver) Merge with OPAVAR/NEMOVAR 10 10 !! NEMO 3.3 ! 2010-05 (D. Lea) Update to work with NEMO v3.2 11 !! - ! 2010-05 (D. Lea) add calc_month_len routine based on day_init 11 !! - ! 2010-05 (D. Lea) add calc_month_len routine based on day_init 12 12 !! 3.4 ! 2012-10 (A. Weaver and K. Mogensen) Fix for direct initialization 13 13 !! ! 2014-09 (D. Lea) Local calc_date removed use routine from OBS … … 31 31 USE zpshde ! Partial step : Horizontal Derivative 32 32 USE asmpar ! Parameters for the assmilation interface 33 USE asmbkg ! 33 USE asmbkg ! 34 34 USE c1d ! 1D initialization 35 35 USE sbc_oce ! Surface boundary condition variables. … … 45 45 IMPLICIT NONE 46 46 PRIVATE 47 47 48 48 PUBLIC asm_inc_init !: Initialize the increment arrays and IAU weights 49 49 PUBLIC tra_asm_inc !: Apply the tracer (T and S) increments … … 72 72 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: u_bkg , v_bkg !: Background u- & v- velocity components 73 73 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: t_bkginc, s_bkginc !: Increment to the background T & S 74 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: u_bkginc, v_bkginc !: Increment to the u- & v-components 74 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: u_bkginc, v_bkginc !: Increment to the u- & v-components 75 75 REAL(wp), PUBLIC, DIMENSION(:) , ALLOCATABLE :: wgtiau !: IAU weights for each time step 76 76 #if defined key_asminc … … 80 80 INTEGER , PUBLIC :: nitbkg !: Time step of the background state used in the Jb term 81 81 INTEGER , PUBLIC :: nitdin !: Time step of the background state for direct initialization 82 INTEGER , PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 82 INTEGER , PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 83 83 INTEGER , PUBLIC :: nitiaufin !: Time step of the end of the IAU interval 84 ! 84 ! 85 85 INTEGER , PUBLIC :: niaufn !: Type of IAU weighing function: = 0 Constant weighting 86 ! !: = 1 Linear hat-like, centred in middle of IAU interval 86 ! !: = 1 Linear hat-like, centred in middle of IAU interval 87 87 REAL(wp), PUBLIC :: salfixmin !: Ensure that the salinity is larger than this value if (ln_salfix) 88 88 … … 106 106 !!---------------------------------------------------------------------- 107 107 !! *** ROUTINE asm_inc_init *** 108 !! 108 !! 109 109 !! ** Purpose : Initialize the assimilation increment and IAU weights. 110 110 !! 111 111 !! ** Method : Initialize the assimilation increment and IAU weights. 112 112 !! 113 !! ** Action : 113 !! ** Action : 114 114 !!---------------------------------------------------------------------- 115 115 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices … … 263 263 ! 264 264 ! !--------------------------------------------------------- 265 IF( niaufn == 0 ) THEN ! Constant IAU forcing 265 IF( niaufn == 0 ) THEN ! Constant IAU forcing 266 266 ! !--------------------------------------------------------- 267 267 DO jt = 1, iiauper … … 269 269 END DO 270 270 ! !--------------------------------------------------------- 271 ELSEIF ( niaufn == 1 ) THEN ! Linear hat-like, centred in middle of IAU interval 271 ELSEIF ( niaufn == 1 ) THEN ! Linear hat-like, centred in middle of IAU interval 272 272 ! !--------------------------------------------------------- 273 273 ! Compute the normalization factor 274 274 znorm = 0._wp 275 275 IF( MOD( iiauper, 2 ) == 0 ) THEN ! Even number of time steps in IAU interval 276 imid = iiauper / 2 276 imid = iiauper / 2 277 277 DO jt = 1, imid 278 278 znorm = znorm + REAL( jt ) … … 280 280 znorm = 2.0 * znorm 281 281 ELSE ! Odd number of time steps in IAU interval 282 imid = ( iiauper + 1 ) / 2 282 imid = ( iiauper + 1 ) / 2 283 283 DO jt = 1, imid - 1 284 284 znorm = znorm + REAL( jt ) … … 307 307 DO jt = 1, icycper 308 308 ztotwgt = ztotwgt + wgtiau(jt) 309 WRITE(numout,*) ' ', jt, ' ', wgtiau(jt) 310 END DO 309 WRITE(numout,*) ' ', jt, ' ', wgtiau(jt) 310 END DO 311 311 WRITE(numout,*) ' ===================================' 312 312 WRITE(numout,*) ' Time-integrated weight = ', ztotwgt 313 313 WRITE(numout,*) ' ===================================' 314 314 ENDIF 315 315 316 316 ENDIF 317 317 … … 338 338 CALL iom_open( c_asminc, inum ) 339 339 ! 340 CALL iom_get( inum, 'time' , zdate_inc ) 340 CALL iom_get( inum, 'time' , zdate_inc ) 341 341 CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb ) 342 342 CALL iom_get( inum, 'z_inc_datef', z_inc_datef ) … … 345 345 ! 346 346 IF(lwp) THEN 347 WRITE(numout,*) 347 WRITE(numout,*) 348 348 WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef 349 349 WRITE(numout,*) '~~~~~~~~~~~~' … … 359 359 & ' not agree with Direct Initialization time' ) 360 360 361 IF ( ln_trainc ) THEN 361 IF ( ln_trainc ) THEN 362 362 CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 ) 363 363 CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 ) … … 371 371 ENDIF 372 372 373 IF ( ln_dyninc ) THEN 374 CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 ) 375 CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 ) 373 IF ( ln_dyninc ) THEN 374 CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 ) 375 CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 ) 376 376 ! Apply the masks 377 377 u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) … … 382 382 WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0 383 383 ENDIF 384 384 385 385 IF ( ln_sshinc ) THEN 386 386 CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 ) … … 408 408 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN ! Apply divergence damping filter 409 409 ! !-------------------------------------- 410 ALLOCATE( zhdiv(jpi,jpj) ) 410 ALLOCATE( zhdiv(jpi,jpj) ) 411 411 ! 412 412 DO jt = 1, nn_divdmp … … 427 427 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 428 428 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) & 429 & + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 429 & + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 430 430 END_2D 431 431 END DO … … 433 433 END DO 434 434 ! 435 DEALLOCATE( zhdiv ) 435 DEALLOCATE( zhdiv ) 436 436 ! 437 437 ENDIF … … 454 454 CALL iom_open( c_asmdin, inum ) 455 455 ! 456 CALL iom_get( inum, 'rdastp', zdate_bkg ) 456 CALL iom_get( inum, 'rdastp', zdate_bkg ) 457 457 ! 458 458 IF(lwp) THEN 459 WRITE(numout,*) 459 WRITE(numout,*) 460 460 WRITE(numout,*) ' ==>>> Assimilation background state valid at : ', zdate_bkg 461 461 WRITE(numout,*) … … 466 466 & ' not agree with Direct Initialization time' ) 467 467 ! 468 IF ( ln_trainc ) THEN 468 IF ( ln_trainc ) THEN 469 469 CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg ) 470 470 CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg ) … … 473 473 ENDIF 474 474 ! 475 IF ( ln_dyninc ) THEN 475 IF ( ln_dyninc ) THEN 476 476 CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg ) 477 477 CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg ) … … 501 501 ! 502 502 END SUBROUTINE asm_inc_init 503 504 503 504 505 505 SUBROUTINE tra_asm_inc( kt, Kbb, Kmm, pts, Krhs ) 506 506 !!---------------------------------------------------------------------- 507 507 !! *** ROUTINE tra_asm_inc *** 508 !! 508 !! 509 509 !! ** Purpose : Apply the tracer (T and S) assimilation increments 510 510 !! 511 511 !! ** Method : Direct initialization or Incremental Analysis Updating 512 512 !! 513 !! ** Action : 513 !! ** Action : 514 514 !!---------------------------------------------------------------------- 515 515 INTEGER , INTENT(in ) :: kt ! Current time step … … 523 523 !!---------------------------------------------------------------------- 524 524 ! 525 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 ! used to prevent the applied increments taking the temperature below the local freezing point 525 ! freezing point calculation taken from oc_fz_pt (but calculated for all depths) 526 ! used to prevent the applied increments taking the temperature below the local freezing point 527 527 DO jk = 1, jpkm1 528 528 CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) … … 539 539 ! 540 540 IF(lwp) THEN 541 WRITE(numout,*) 541 WRITE(numout,*) 542 542 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 543 543 WRITE(numout,*) '~~~~~~~~~~~~' … … 549 549 ! Do not apply negative increments if the temperature will fall below freezing 550 550 WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 551 & pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 552 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 551 & pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) ) 552 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 553 553 END WHERE 554 554 ELSE 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 555 pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt 556 556 ENDIF 557 557 IF (ln_salfix) THEN … … 559 559 ! minimum value salfixmin 560 560 WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 561 & pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 561 & pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin ) 562 562 pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 563 563 END WHERE … … 576 576 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 577 577 ! !-------------------------------------- 578 ! 578 ! 579 579 IF ( kt == nitdin_r ) THEN 580 580 ! … … 584 584 IF (ln_temnofreeze) THEN 585 585 ! Do not apply negative increments if the temperature will fall below freezing 586 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 587 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 586 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 587 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 588 588 END WHERE 589 589 ELSE 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 590 pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 591 591 ENDIF 592 592 IF (ln_salfix) THEN 593 593 ! Do not apply negative increments if the salinity will fall below a specified 594 594 ! minimum value salfixmin 595 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 596 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 595 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 596 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 597 597 END WHERE 598 598 ELSE 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 599 pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 600 600 ENDIF 601 601 … … 619 619 DEALLOCATE( s_bkg ) 620 620 ENDIF 621 ! 621 ! 622 622 ENDIF 623 623 ! Perhaps the following call should be in step … … 630 630 !!---------------------------------------------------------------------- 631 631 !! *** ROUTINE dyn_asm_inc *** 632 !! 632 !! 633 633 !! ** Purpose : Apply the dynamics (u and v) assimilation increments. 634 634 !! 635 635 !! ** Method : Direct initialization or Incremental Analysis Updating. 636 636 !! 637 !! ** Action : 637 !! ** Action : 638 638 !!---------------------------------------------------------------------- 639 639 INTEGER , INTENT( in ) :: kt ! ocean time-step index … … 656 656 ! 657 657 IF(lwp) THEN 658 WRITE(numout,*) 658 WRITE(numout,*) 659 659 WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 660 660 WRITE(numout,*) '~~~~~~~~~~~~' … … 676 676 ELSEIF ( ln_asmdin ) THEN ! Direct Initialization 677 677 ! !----------------------------------------- 678 ! 678 ! 679 679 IF ( kt == nitdin_r ) THEN 680 680 ! … … 683 683 ! Initialize the now fields with the background + increment 684 684 puu(:,:,:,Kmm) = u_bkg(:,:,:) + u_bkginc(:,:,:) 685 pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:) 685 pvv(:,:,:,Kmm) = v_bkg(:,:,:) + v_bkginc(:,:,:) 686 686 ! 687 687 puu(:,:,:,Kbb) = puu(:,:,:,Kmm) ! Update before fields … … 702 702 !!---------------------------------------------------------------------- 703 703 !! *** ROUTINE ssh_asm_inc *** 704 !! 704 !! 705 705 !! ** Purpose : Apply the sea surface height assimilation increment. 706 706 !! 707 707 !! ** Method : Direct initialization or Incremental Analysis Updating. 708 708 !! 709 !! ** Action : 709 !! ** Action : 710 710 !!---------------------------------------------------------------------- 711 711 INTEGER, INTENT(IN) :: kt ! Current time step … … 727 727 ! 728 728 IF(lwp) THEN 729 WRITE(numout,*) 729 WRITE(numout,*) 730 730 WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 731 731 & kt,' with IAU weight = ', wgtiau(it) … … 779 779 !! *** ROUTINE ssh_asm_div *** 780 780 !! 781 !! ** Purpose : ssh increment with z* is incorporated via a correction of the local divergence 781 !! ** Purpose : ssh increment with z* is incorporated via a correction of the local divergence 782 782 !! across all the water column 783 783 !! … … 795 795 REAL(wp), DIMENSION(:,:) , POINTER :: ztim ! local array 796 796 !!---------------------------------------------------------------------- 797 ! 797 ! 798 798 #if defined key_asminc 799 799 CALL ssh_asm_inc( kt, Kbb, Kmm ) !== (calculate increments) 800 800 ! 801 IF( ln_linssh ) THEN 801 IF( ln_linssh ) THEN 802 802 phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 803 ELSE 803 ELSE 804 804 ALLOCATE( ztim(jpi,jpj) ) 805 805 ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 806 DO jk = 1, jpkm1 807 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 806 DO jk = 1, jpkm1 807 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 808 808 END DO 809 809 ! … … 818 818 !!---------------------------------------------------------------------- 819 819 !! *** ROUTINE seaice_asm_inc *** 820 !! 820 !! 821 821 !! ** Purpose : Apply the sea ice assimilation increment. 822 822 !! 823 823 !! ** Method : Direct initialization or Incremental Analysis Updating. 824 824 !! 825 !! ** Action : 825 !! ** Action : 826 826 !! 827 827 !!---------------------------------------------------------------------- … … 844 844 ! 845 845 it = kt - nit000 + 1 846 zincwgt = wgtiau(it) ! IAU weight for the current time step 846 zincwgt = wgtiau(it) ! IAU weight for the current time step 847 847 ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 848 848 ! 849 849 IF(lwp) THEN 850 WRITE(numout,*) 850 WRITE(numout,*) 851 851 WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 852 852 WRITE(numout,*) '~~~~~~~~~~~~' … … 866 866 ! 867 867 ! Nudge sea ice depth to bring it up to a required minimum depth 868 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 869 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 868 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 869 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 870 870 ELSEWHERE 871 871 zhicifinc(:,:) = 0.0_wp … … 907 907 zofrld (:,:) = 1._wp - at_i(:,:) 908 908 zohicif(:,:) = hm_i(:,:) 909 ! 909 ! 910 910 ! Initialize the now fields the background + increment 911 911 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 912 at_i_b(:,:) = at_i(:,:) 912 at_i_b(:,:) = at_i(:,:) 913 913 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 914 914 ! … … 916 916 ! 917 917 ! Nudge sea ice depth to bring it up to a required minimum depth 918 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 918 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 919 919 zhicifinc(:,:) = zhicifmin - hm_i(:,:) 920 920 ELSEWHERE … … 946 946 !#if defined defined key_si3 || defined key_cice 947 947 ! 948 ! IF (ln_seaicebal ) THEN 948 ! IF (ln_seaicebal ) THEN 949 949 ! !! balancing salinity increments 950 950 ! !! simple case from limflx.F90 (doesn't include a mass flux) … … 958 958 ! 959 959 ! DO jj = 1, jpj 960 ! DO ji = 1, jpi 960 ! DO ji = 1, jpi 961 961 ! ! calculate change in ice and snow mass per unit area 962 962 ! ! positive values imply adding salt to the ocean (results from ice formation) … … 969 969 ! 970 970 ! ! prevent small mld 971 ! ! less than 10m can cause salinity instability 971 ! ! less than 10m can cause salinity instability 972 972 ! IF (mld < 10) mld=10 973 973 ! 974 ! ! set to bottom of a level 974 ! ! set to bottom of a level 975 975 ! DO jk = jpk-1, 2, -1 976 ! IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN 976 ! IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN 977 977 ! mld=gdepw(ji,jj,jk+1) 978 978 ! jkmax=jk … … 981 981 ! 982 982 ! ! avoid applying salinity balancing in shallow water or on land 983 ! ! 983 ! ! 984 984 ! 985 985 ! ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m) … … 992 992 ! 993 993 ! ! put increments in for levels in the mixed layer 994 ! ! but prevent salinity below a threshold value 995 ! 996 ! DO jk = 1, jkmax 997 ! 998 ! IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN 994 ! ! but prevent salinity below a threshold value 995 ! 996 ! DO jk = 1, jkmax 997 ! 998 ! IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN 999 999 ! sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn 1000 1000 ! sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn … … 1007 1007 ! ! 1008 1008 ! !! Adjust fsalt. A +ve fsalt means adding salt to ocean 1009 ! !! fsalt(ji,jj) = fsalt(ji,jj) + zpmess ! adjust fsalt 1010 ! !! 1011 ! !! emps(ji,jj) = emps(ji,jj) + zpmess ! or adjust emps (see icestp1d) 1009 ! !! fsalt(ji,jj) = fsalt(ji,jj) + zpmess ! adjust fsalt 1010 ! !! 1011 ! !! emps(ji,jj) = emps(ji,jj) + zpmess ! or adjust emps (see icestp1d) 1012 1012 ! !! ! E-P (kg m-2 s-2) 1013 1013 ! ! emp(ji,jj) = emp(ji,jj) + zpmess ! E-P (kg m-2 s-2) … … 1022 1022 ! 1023 1023 END SUBROUTINE seaice_asm_inc 1024 1024 1025 1025 !!====================================================================== 1026 1026 END MODULE asminc -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydta.F90
r12616 r12680 251 251 ij = idx_bdy(jbdy)%nbj(ib,igrd) 252 252 DO ik = 1, jpkm1 253 dta_alias%u2d(ib) = &254 & dta_alias%u2d(ib)+ e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)253 dta_alias%u2d(ib) = dta_alias%u2d(ib) & 254 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 255 255 END DO 256 256 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) … … 265 265 ij = idx_bdy(jbdy)%nbj(ib,igrd) 266 266 DO ik = 1, jpkm1 267 dta_alias%v2d(ib) = &268 & dta_alias%v2d(ib)+ e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)267 dta_alias%v2d(ib) = dta_alias%v2d(ib) & 268 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 269 269 END DO 270 270 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydyn.F90
r12625 r12680 37 37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 40 39 CONTAINS 41 40 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/C1D/step_c1d.F90
r12377 r12680 83 83 IF(.NOT.ln_linssh ) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 84 84 85 IF(.NOT.ln_linssh ) CALL wzv ( kstp, Nbb, Nnn, ww, Naa) ! now cross-level velocity85 IF(.NOT.ln_linssh ) CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! now cross-level velocity 86 86 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 87 87 ! diagnostics and outputs -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90
r12625 r12680 35 35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 38 37 CONTAINS 39 38 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90
r12622 r12680 78 78 ! 79 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z pe, z2d! 2D workspace81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z rhd , zrhop, ztpot, ze3t! 3D workspace80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd , zrhop, ztpot ! 3D workspace 82 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 83 83 … … 104 104 END DO 105 105 DO jk = 1, jpk 106 z e3t(:,:,jk) = e3t(:,:,jk,Kmm)106 z3d(:,:,jk) = rau0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 107 107 END DO 108 108 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 109 CALL iom_put( 'masscello' , rau0 * ze3t(:,:,:) * tmask(:,:,:) )! ocean mass109 CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass 110 110 ENDIF 111 111 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diadct.F90
r12625 r12680 11 11 !! 3.4 ! 09/2011 (C Bricaud) 12 12 !!---------------------------------------------------------------------- 13 !! does not work with agrif 14 #if ! defined key_agrif13 #if ! defined key_agrif 14 !! ==>> CAUTION: does not work with agrif 15 15 !!---------------------------------------------------------------------- 16 16 !! dia_dct : Compute the transport through a sec. … … 66 66 TYPE SECTION 67 67 CHARACTER(len=60) :: name ! name of the sec 68 LOGICAL :: llstrpond ! true if you want the computation of salt and 69 ! heat transports 68 LOGICAL :: llstrpond ! true if you want the computation of salt and heat transports 70 69 LOGICAL :: ll_ice_section ! ice surface and ice volume computation 71 70 LOGICAL :: ll_date_line ! = T if the section crosses the date-line … … 74 73 INTEGER, DIMENSION(nb_point_max) :: direction ! vector direction of the point in the section 75 74 CHARACTER(len=40),DIMENSION(nb_class_max) :: classname ! characteristics of the class 76 REAL(wp), DIMENSION(nb_class_max) :: zsigi ,&! in-situ density classes (99 if you don't want)77 zsigp ,&! potential density classes (99 if you don't want)78 zsal ,&! salinity classes (99 if you don't want)79 ztem ,&! temperature classes(99 if you don't want)80 75 REAL(wp), DIMENSION(nb_class_max) :: zsigi ! in-situ density classes (99 if you don't want) 76 REAL(wp), DIMENSION(nb_class_max) :: zsigp ! potential density classes (99 if you don't want) 77 REAL(wp), DIMENSION(nb_class_max) :: zsal ! salinity classes (99 if you don't want) 78 REAL(wp), DIMENSION(nb_class_max) :: ztem ! temperature classes(99 if you don't want) 79 REAL(wp), DIMENSION(nb_class_max) :: zlay ! level classes (99 if you don't want) 81 80 REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport ! transport output 82 81 REAL(wp) :: slopeSection ! slope of the section … … 89 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d 90 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 90 91 91 92 92 !! * Substitutions … … 1122 1122 !! | | | interpolation between ptab(I,J,K) and ptab(I,J,K+1) 1123 1123 !! | | | zbis = 1124 !! | | | [ e3w_n(I+1,J,K )*ptab(I,J,K) + ( e3w_n(I,J,K) - e3w_n(I+1,J,K) ) * ptab(I,J,K-1) ]1125 !! | | | /[ e3w_n(I+1,J,K) + e3w_n(I,J,K) - e3w_n(I+1,J,K) ]1124 !! | | | [ e3w_n(I+1,J,K,NOW)*ptab(I,J,K) + ( e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ) * ptab(I,J,K-1) ] 1125 !! | | | /[ e3w_n(I+1,J,K,NOW) + e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ] 1126 1126 !! | | | 1127 1127 !! | | | 2. Horizontal interpolation: compute value at U/V point -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diahsb.F90
r12625 r12680 57 57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- 59 60 59 CONTAINS 61 60 … … 159 158 ! 160 159 DO jk = 1, jpkm1 ! volume variation (calculated with scale factors) 161 zwrk(:,:,jk) = surf (:,:) * e3t(:,:,jk,Kmm)*tmask(:,:,jk) &160 zwrk(:,:,jk) = surf (:,:) * e3t (:,:,jk,Kmm)*tmask (:,:,jk) & 162 161 & - surf_ini(:,:) * e3t_ini(:,:,jk )*tmask_ini(:,:,jk) 163 162 END DO 164 163 zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) ! glob_sum_full needed as tmask and tmask_ini could be different 165 164 DO jk = 1, jpkm1 ! heat content variation 166 zwrk(:,:,jk) = ( surf (:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) &167 & - surf_ini(:,:) *hc_loc_ini(:,:,jk) )165 zwrk(:,:,jk) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) & 166 & - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) 168 167 END DO 169 168 zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 170 169 DO jk = 1, jpkm1 ! salt content variation 171 zwrk(:,:,jk) = ( surf (:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) &172 & - surf_ini(:,:) *sc_loc_ini(:,:,jk) )170 zwrk(:,:,jk) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) & 171 & - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) 173 172 END DO 174 173 zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diamlr.F90
r12482 r12680 4 4 !! Management of the IOM context for multiple-linear-regression analysis 5 5 !!====================================================================== 6 !! History : ! 2019 (S. Mueller)6 !! History : 4.0 ! 2019 (S. Mueller) Original code 7 7 !!---------------------------------------------------------------------- 8 8 9 9 USE par_oce , ONLY : wp, jpi, jpj 10 10 USE phycst , ONLY : rpi 11 USE dom_oce , ONLY : adatrj 12 USE tide_mod 13 ! 11 14 USE in_out_manager , ONLY : lwp, numout, ln_timing 12 15 USE iom , ONLY : iom_put, iom_use, iom_update_file_name 13 USE dom_oce , ONLY : adatrj14 16 USE timing , ONLY : timing_start, timing_stop 15 17 #if defined key_iomput 16 18 USE xios 17 19 #endif 18 USE tide_mod19 20 20 21 IMPLICIT NONE 21 22 PRIVATE 22 23 23 LOGICAL, PUBLIC :: lk_diamlr = .FALSE. 24 LOGICAL, PUBLIC :: lk_diamlr = .FALSE. !: ===>>> NOT a DOCTOR norm name : use l_diamlr 25 ! lk_ is used only for logical controlled by a CPP key 24 26 25 27 PUBLIC :: dia_mlr_init, dia_mlr_iom_init, dia_mlr … … 42 44 !! 43 45 !!---------------------------------------------------------------------- 44 46 ! 45 47 lk_diamlr = .TRUE. 46 48 ! 47 49 IF(lwp) THEN 48 50 WRITE(numout, *) … … 50 52 WRITE(numout, *) '~~~~~~~~~~~~ multiple-linear-regression analysis' 51 53 END IF 52 54 ! 53 55 END SUBROUTINE dia_mlr_init 56 54 57 55 58 SUBROUTINE dia_mlr_iom_init … … 396 399 END SUBROUTINE dia_mlr_iom_init 397 400 401 398 402 SUBROUTINE dia_mlr 399 403 !!---------------------------------------------------------------------- … … 403 407 !! 404 408 !!---------------------------------------------------------------------- 405 406 409 REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d 410 !!---------------------------------------------------------------------- 407 411 408 412 IF( ln_timing ) CALL timing_start('dia_mlr') … … 411 415 ! (value of adatrj converted to time in units of seconds) 412 416 ! 413 ! A 2-dimensional field of constant value is sent, and subsequently used 414 ! directly or transformed to a scalar or a constant 3-dimensional field as 415 ! required. 417 ! A 2-dimensional field of constant value is sent, and subsequently used directly 418 ! or transformed to a scalar or a constant 3-dimensional field as required. 416 419 zadatrj2d(:,:) = adatrj*86400.0_wp 417 420 IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d) 418 421 ! 419 422 IF( ln_timing ) CALL timing_stop('dia_mlr') 420 423 ! 421 424 END SUBROUTINE dia_mlr 422 425 426 !!====================================================================== 423 427 END MODULE diamlr -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaptr.F90
r12622 r12680 60 60 61 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini) 62 62 63 !! * Substitutions 63 64 # include "do_loop_substitute.h90" -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90
r12622 r12680 121 121 REAL(wp):: zztmp2, zztmpy ! - - 122 122 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 123 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d , ze3t, ze3u, ze3v, ze3w! 3D workspace123 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 124 124 !!---------------------------------------------------------------------- 125 125 ! … … 137 137 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 138 138 ! 139 DO jk = 1, jpk 140 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 141 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 142 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 143 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 144 END DO 145 ! 146 CALL iom_put( "e3t" , ze3t(:,:,:) ) 147 CALL iom_put( "e3u" , ze3u(:,:,:) ) 148 CALL iom_put( "e3v" , ze3v(:,:,:) ) 149 CALL iom_put( "e3w" , ze3w(:,:,:) ) 150 IF( iom_use("e3tdef") ) & 151 CALL iom_put( "e3tdef" , ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) !!st r3t 152 153 IF( ll_wd ) THEN 154 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying) 139 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 140 DO jk = 1, jpk 141 z3d(:,:,jk) = e3t(:,:,jk,Kmm) 142 END DO 143 CALL iom_put( "e3t" , z3d(:,:,:) ) 144 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) !!st r3t 145 ENDIF 146 IF ( iom_use("e3u") ) THEN ! time-varying e3u 147 DO jk = 1, jpk 148 z3d(:,:,jk) = e3u(:,:,jk,Kmm) 149 END DO 150 CALL iom_put( "e3u" , z3d(:,:,:) ) 151 ENDIF 152 IF ( iom_use("e3v") ) THEN ! time-varying e3v 153 DO jk = 1, jpk 154 z3d(:,:,jk) = e3v(:,:,jk,Kmm) 155 END DO 156 CALL iom_put( "e3v" , z3d(:,:,:) ) 157 ENDIF 158 IF ( iom_use("e3w") ) THEN ! time-varying e3w 159 DO jk = 1, jpk 160 z3d(:,:,jk) = e3w(:,:,jk,Kmm) 161 END DO 162 CALL iom_put( "e3w" , z3d(:,:,:) ) 163 ENDIF 164 165 IF( ll_wd ) THEN ! sea surface height (brought back to the reference used for wetting and drying) 166 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 155 167 ELSE 156 168 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height … … 216 228 217 229 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 218 !219 230 CALL iom_put( "woce", ww ) ! vertical velocity 231 220 232 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 221 233 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. … … 777 789 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! heat content 778 790 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! salt content 779 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface heat content780 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity content791 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 792 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 781 793 ELSE 782 794 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature … … 930 942 !!---------------------------------------------------------------------- 931 943 ! 932 IF(lwp) WRITE(numout,*) 933 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 934 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 935 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 936 944 IF(lwp) THEN 945 WRITE(numout,*) 946 WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 947 WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 948 WRITE(numout,*) ' and named :', cdfile_name, '...nc' 949 ENDIF 950 ! 937 951 DO jk = 1, jpk 938 952 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 939 953 END DO 940 954 ! 941 955 #if defined key_si3 942 956 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90
r12482 r12680 2 2 !!====================================================================== 3 3 !! *** MODULE dom_oce *** 4 !!5 4 !! ** Purpose : Define in memory all the ocean space domain variables 6 5 !!====================================================================== … … 75 74 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 76 75 77 ! !domain MPP decomposition parameters76 ! !: domain MPP decomposition parameters 78 77 INTEGER , PUBLIC :: nimpp, njmpp !: i- & j-indexes for mpp-subdomain left bottom 79 78 INTEGER , PUBLIC :: nreci, nrecj !: overlap region in i and j … … 138 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m] 139 138 ! ! time-dependent scale factors 139 #if ! defined key_qco 140 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m] 141 141 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m] 142 #endif 142 143 ! ! time-dependent ratio ssh / h_0 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: [-]144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: [-]145 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: [-]144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-] 145 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-] 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-] 146 147 147 148 ! ! reference depths of cells 148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m]149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m] 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m] 151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] 151 152 ! ! time-dependent depths of cells 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w 154 155 ! ! reference heights of water column 156 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: t-depth [m] 157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 !: u-depth [m] 158 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0 !: v-depth [m] 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0 !: f-depth [m] 160 ! ! reciprocal reference heights of water column 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_ht_0, r1_hu_0, r1_hv_0, r1_hf_0 !: t-depth [1/m] 162 ! time-dependent heights of water column 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: height of water column at T-points [m] 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, hv, r1_hu, r1_hv !: height of water column [m] and reciprocal [1/m] 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w 155 156 ! ! reference heights of ocean water column and its inverse 157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m] 158 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m] 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m] 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m] 161 ! ! time-dependent heights of ocean water column 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m] 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m] 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m] 165 165 166 166 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 178 178 !! --------------------------------------------------------------------- 179 179 !!gm Proposition of new name for top/bottom vertical indices 180 ! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, V-, F-level (ISF)181 ! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-and V-level180 ! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF) 181 ! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level 182 182 !!gm 183 183 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv !: bottom last wet T-, U- and V-level … … 187 187 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF) 188 188 189 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask!: surface mask at T-,U-, V- and F-pts190 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts189 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts 190 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts 192 192 193 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tpol, fpol !: north fold mask (jperio= 3 or 4) … … 211 211 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 212 212 ! !: (cumulative duration of previous runs that may have used different time-step size) 213 INTEGER , PUBLIC, DIMENSION( 0: 2) :: nyear_len !: length in days of the previous/current/next year214 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_len !: length in days of the months of the current year215 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_beg !: second since Jan 1st 0h of the current year and the half of the months216 INTEGER , PUBLIC :: nsec1jan000!: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year217 INTEGER , PUBLIC :: nsec000_1jan000 !: second since Jan 1st 0h of nit000 year and nit000218 INTEGER , PUBLIC :: nsecend_1jan000 !: second since Jan 1st 0h of nit000 year and nitend213 INTEGER , PUBLIC, DIMENSION( 0: 2) :: nyear_len !: length in days of the previous/current/next year 214 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_len !: length in days of the months of the current year 215 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_beg !: second since Jan 1st 0h of the current year and the half of the months 216 INTEGER , PUBLIC :: nsec1jan000 !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 217 INTEGER , PUBLIC :: nsec000_1jan000 !: second since Jan 1st 0h of nit000 year and nit000 218 INTEGER , PUBLIC :: nsecend_1jan000 !: second since Jan 1st 0h of nit000 year and nitend 219 219 220 220 !!---------------------------------------------------------------------- … … 249 249 INTEGER FUNCTION dom_oce_alloc() 250 250 !!---------------------------------------------------------------------- 251 INTEGER, DIMENSION(12) :: ierr 251 INTEGER :: ii 252 INTEGER, DIMENSION(30) :: ierr 252 253 !!---------------------------------------------------------------------- 253 i err(:) = 0254 ii = 0 ; ierr(:) = 0 254 255 ! 255 ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) ) 256 ! 257 ALLOCATE( mi0(jpiglo) , mi1 (jpiglo), mj0(jpjglo) , mj1 (jpjglo) , & 258 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 259 ! 256 ii = ii+1 257 ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(ii) ) 258 ! 259 ii = ii+1 260 ALLOCATE( mi0 (jpiglo) , mi1 (jpiglo), mj0(jpjglo) , mj1 (jpjglo) , & 261 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(ii) ) 262 ! 263 ii = ii+1 260 264 ALLOCATE( glamt(jpi,jpj) , glamu(jpi,jpj) , glamv(jpi,jpj) , glamf(jpi,jpj) , & 261 265 & gphit(jpi,jpj) , gphiu(jpi,jpj) , gphiv(jpi,jpj) , gphif(jpi,jpj) , & … … 268 272 & e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj) , & 269 273 & e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj) , & 270 & ff_f (jpi,jpj) , ff_t (jpi,jpj) , STAT=ierr(3) ) 271 ! 274 & ff_f (jpi,jpj) , ff_t (jpi,jpj) , STAT=ierr(ii) ) 275 ! 276 ii = ii+1 272 277 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & 273 & gdept (jpi,jpj,jpk,jpt) , gdepw (jpi,jpj,jpk,jpt) , gde3w (jpi,jpj,jpk) , STAT=ierr(4) ) 274 ! 275 ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , & 276 & e3t (jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f (jpi,jpj,jpk) , e3w (jpi,jpj,jpk,jpt) , & 277 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & 278 & e3uw (jpi,jpj,jpk,jpt) , e3vw (jpi,jpj,jpk,jpt) , & 279 & r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 280 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(5) ) 281 ! 282 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 283 & ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 284 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , & 285 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(6) ) 286 ! 287 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(7) ) 288 ! 289 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(8) ) 290 ! 291 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 292 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 293 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(9) ) 294 ! 295 ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(10) ) 296 ! 278 & gdept (jpi,jpj,jpk,jpt) , gdepw (jpi,jpj,jpk,jpt) , gde3w (jpi,jpj,jpk) , STAT=ierr(ii) ) 279 ! 280 ii = ii+1 281 ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0 (jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , & 282 & e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(ii) ) 283 ! 284 #if ! defined key_qco 285 ii = ii+1 286 ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) , & 287 & e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt) , STAT=ierr(ii) ) 288 #endif 289 ! 290 ii = ii+1 291 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 292 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 293 ! 294 ii = ii+1 295 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 296 & ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 297 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , & 298 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(ii) ) 299 ! 300 ii = ii+1 301 ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) ) 302 ! 303 ii = ii+1 304 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(ii) ) 305 ! 306 ii = ii+1 307 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 308 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 309 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(ii) ) 310 ! 311 ii = ii+1 312 ALLOCATE( mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj), mikf(jpi,jpj), STAT=ierr(ii) ) 313 ! 314 ii = ii+1 297 315 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & 298 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) ) 299 ! 300 ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) 316 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 317 ! 318 ii = ii+1 319 ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 301 320 ! 302 321 dom_oce_alloc = MAXVAL(ierr) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90
r12482 r12680 35 35 USE dommsk ! domain: set the mask system 36 36 USE domwri ! domain: write the meshmask file 37 #if ! defined key_qco 37 38 USE domvvl ! variable volume 39 #else 40 USE domqe ! variable volume 41 #endif 38 42 USE c1d ! 1D configuration 39 43 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) … … 77 81 CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables 78 82 ! 79 INTEGER :: ji, jj, jk, ik! dummy loop indices83 INTEGER :: ji, jj, jk, jt ! dummy loop indices 80 84 INTEGER :: iconf = 0 ! local integers 81 85 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" … … 111 115 CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)' 112 116 CASE DEFAULT 113 CALL ctl_stop( ' jperio is out of range' )117 CALL ctl_stop( 'dom_init: jperio is out of range' ) 114 118 END SELECT 115 119 WRITE(numout,*) ' Ocean model configuration used:' … … 141 145 IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes 142 146 143 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry 147 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices) 144 148 145 149 CALL dom_msk( ik_top, ik_bot ) ! Masks … … 160 164 r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 161 165 r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) ) 166 162 167 ! 163 168 ! !== time varying part of coordinate system ==! 164 169 ! 165 170 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 166 ! 167 ! before ! now ! after ! 168 gdept(:,:,:,Kbb) = gdept_0 ; gdept(:,:,:,Kmm) = gdept_0 ; gdept(:,:,:,Kaa) = gdept_0 ! depth of grid-points 169 gdepw(:,:,:,Kbb) = gdepw_0 ; gdepw(:,:,:,Kmm) = gdepw_0 ; gdepw(:,:,:,Kaa) = gdepw_0 ! 170 gde3w = gde3w_0 ! --- ! 171 ! 172 e3t(:,:,:,Kbb) = e3t_0 ; e3t(:,:,:,Kmm) = e3t_0 ; e3t(:,:,:,Kaa) = e3t_0 ! scale factors 173 e3u(:,:,:,Kbb) = e3u_0 ; e3u(:,:,:,Kmm) = e3u_0 ; e3u(:,:,:,Kaa) = e3u_0 ! 174 e3v(:,:,:,Kbb) = e3v_0 ; e3v(:,:,:,Kmm) = e3v_0 ; e3v(:,:,:,Kaa) = e3v_0 ! 175 e3f = e3f_0 ! --- ! 176 e3w(:,:,:,Kbb) = e3w_0 ; e3w(:,:,:,Kmm) = e3w_0 ; e3w(:,:,:,Kaa) = e3w_0 ! 177 e3uw(:,:,:,Kbb) = e3uw_0 ; e3uw(:,:,:,Kmm) = e3uw_0 ; e3uw(:,:,:,Kaa) = e3uw_0 ! 178 e3vw(:,:,:,Kbb) = e3vw_0 ; e3vw(:,:,:,Kmm) = e3vw_0 ; e3vw(:,:,:,Kaa) = e3vw_0 ! 179 ! 180 ! !!st new variable h1_hu_0 h1_hv_0 181 ! z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 182 ! z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 183 ! 184 ! before ! now ! after ! 185 ht = ht_0 ! ! water column thickness 186 hu(:,:,Kbb) = hu_0 ; hu(:,:,Kmm) = hu_0 ; hu(:,:,Kaa) = hu_0 ! 187 hv(:,:,Kbb) = hv_0 ; hv(:,:,Kmm) = hv_0 ; hv(:,:,Kaa) = hv_0 ! 188 r1_hu(:,:,Kbb) = r1_hu_0 ; r1_hu(:,:,Kmm) = r1_hu_0 ; r1_hu(:,:,Kaa) = r1_hu_0 ! inverse of water column thickness 189 r1_hv(:,:,Kbb) = r1_hv_0 ; r1_hv(:,:,Kmm) = r1_hv_0 ; r1_hv(:,:,Kaa) = r1_hv_0 ! 190 ! 171 ! 172 DO jt = 1, jpt ! depth of t- and w-grid-points 173 gdept(:,:,:,jt) = gdept_0(:,:,:) 174 gdepw(:,:,:,jt) = gdepw_0(:,:,:) 175 END DO 176 gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t 177 ! 178 #if defined key_qco 179 ! Quasi-Euerian coordinate : no initialisation of e3. scale factors 180 #else 181 DO jt = 1, jpt ! vertical scale factors 182 e3t(:,:,:,jt) = e3t_0(:,:,:) 183 e3u(:,:,:,jt) = e3u_0(:,:,:) 184 e3v(:,:,:,jt) = e3v_0(:,:,:) 185 e3w(:,:,:,jt) = e3w_0(:,:,:) 186 e3uw(:,:,:,jt) = e3uw_0(:,:,:) 187 e3vw(:,:,:,jt) = e3vw_0(:,:,:) 188 END DO 189 e3f(:,:,:) = e3f_0(:,:,:) 190 ! 191 #endif 192 ! 193 DO jt = 1, jpt ! water column thickness and its inverse 194 hu(:,:,jt) = hu_0(:,:) 195 hv(:,:,jt) = hv_0(:,:) 196 r1_hu(:,:,jt) = r1_hu_0(:,:) 197 r1_hv(:,:,jt) = r1_hv_0(:,:) 198 END DO 199 ht(:,:) = ht_0(:,:) 191 200 ! 192 201 ELSE != time varying : initialize before/now/after variables 193 202 ! 194 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 203 #if defined key_qco 204 IF( .NOT.l_offline ) CALL dom_qe_init( Kbb, Kmm, Kaa ) 205 #else 206 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 207 #endif 195 208 ! 196 209 ENDIF -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dommsk.F90
r12482 r12680 143 143 ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...) 144 144 CALL lbc_lnk( 'dommsk', tmask , 'T', 1._wp ) ! Lateral boundary conditions 145 145 146 146 ! Mask corrections for bdy (read in mppini2) 147 147 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90
r12679 r12680 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x ! 2020-02 (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate11 !! 4.x ! 2020-02 (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate 12 12 !!---------------------------------------------------------------------- 13 13 14 14 !!---------------------------------------------------------------------- 15 !! dom_qe_init 16 !! dom_qe_sf_nxt 17 !! dom_qe_sf_update 15 !! dom_qe_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qe_sf_nxt : Compute next vertical scale factors 17 !! dom_qe_sf_update: Swap vertical scale factors and update the vertical grid 18 18 !! dom_qe_interpol : Interpolate vertical scale factors from one grid point to another 19 !! dom_qe_r3c 20 !! dom_qe_rst: read/write restart file21 !! dom_qe_ctl 19 !! dom_qe_r3c : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 20 !! qe_rst_read : read/write restart file 21 !! dom_qe_ctl : Check the vvl options 22 22 !!---------------------------------------------------------------------- 23 USE oce 24 USE phycst 25 USE dom_oce 23 USE oce ! ocean dynamics and tracers 24 USE phycst ! physical constant 25 USE dom_oce ! ocean space and time domain 26 26 USE dynadv , ONLY : ln_dynadv_vec 27 USE isf_oce 28 USE sbc_oce 29 USE wet_dry 30 USE usrdef_istate 31 USE restart 27 USE isf_oce ! iceshelf cavities 28 USE sbc_oce ! ocean surface boundary condition 29 USE wet_dry ! wetting and drying 30 USE usrdef_istate ! user defined initial state (wad only) 31 USE restart ! ocean restart 32 32 ! 33 USE in_out_manager 34 USE iom 35 USE lib_mpp 36 USE lbclnk 37 USE timing 33 USE in_out_manager ! I/O manager 34 USE iom ! I/O manager library 35 USE lib_mpp ! distributed memory computing library 36 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 37 USE timing ! Timing 38 38 39 39 IMPLICIT NONE … … 42 42 PUBLIC dom_qe_init ! called by domain.F90 43 43 PUBLIC dom_qe_zgr ! called by isfcpl.F90 44 PUBLIC dom_qe_sf_nxt ! called by steplf.F9045 PUBLIC dom_qe_sf_update ! called by steplf.F9044 !!st PUBLIC dom_qe_sf_nxt ! called by steplf.F90 45 !!st PUBLIC dom_qe_sf_update ! called by steplf.F90 46 46 PUBLIC dom_h_nxt ! called by steplf.F90 47 PUBLIC dom_h_update ! called by steplf.F90 47 48 PUBLIC dom_qe_r3c ! called by steplf.F90 48 49 … … 102 103 ! 103 104 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 104 CALL dom_qe_rst( nit000, Kbb, Kmm, 'READ')105 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all105 CALL qe_rst_read( nit000, Kbb, Kmm ) 106 !!st e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 106 107 ! 107 108 CALL dom_qe_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 108 109 ! 109 IF(lwxios) THEN ! define variables in restart file when writing with XIOS110 CALL iom_set_rstw_var_active('e3t_b')111 CALL iom_set_rstw_var_active('e3t_n')112 ENDIF110 ! IF(lwxios) THEN ! define variables in restart file when writing with XIOS 111 ! CALL iom_set_rstw_var_active('e3t_b') 112 ! CALL iom_set_rstw_var_active('e3t_n') 113 ! ENDIF 113 114 ! 114 115 END SUBROUTINE dom_qe_init … … 147 148 CALL dom_qe_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 148 149 ! 149 DO jk = 1, jpkm1 ! Horizontal interpolation of e3t 150 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) ) ! Kbb time level 151 e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 152 e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 153 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) ! Kmm time level 154 e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 155 e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 156 e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) 157 END DO 158 ! 159 DO jk = 1, jpk ! Vertical interpolation of e3t,u,v 160 ! ! The ratio does not have to be masked at w-level 161 e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 162 e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 163 e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 164 e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 165 e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 166 e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 167 END DO 168 ! 169 ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 170 e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 171 e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 172 e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 150 ! !!st 151 ! DO jk = 1, jpkm1 ! Horizontal interpolation of e3t 152 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) ) ! Kbb time level 153 ! e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 154 ! e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 155 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) ! Kmm time level 156 ! e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 157 ! e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 158 ! e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) 159 ! END DO 160 ! ! 161 ! DO jk = 1, jpk ! Vertical interpolation of e3t,u,v 162 ! ! ! The ratio does not have to be masked at w-level 163 ! e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 164 ! e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 165 ! e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 166 ! e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 167 ! e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 168 ! e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 169 ! END DO 170 ! ! 171 ! ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 172 ! e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 173 ! e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 174 ! e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 175 !!st end 173 176 ! 174 177 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) … … 221 224 END SUBROUTINE dom_qe_zgr 222 225 223 224 SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 226 ! !!st 227 ! SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 228 ! !!---------------------------------------------------------------------- 229 ! !! *** ROUTINE dom_qe_sf_nxt *** 230 ! !! 231 ! !! ** Purpose : - compute the after scale factors used in tra_zdf, dynnxt, 232 ! !! tranxt and dynspg routines 233 ! !! 234 ! !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 235 ! !! 236 ! !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 237 ! !! - tilde_e3t_a: after increment of vertical scale factor 238 ! !! in z_tilde case 239 ! !! - e3(t/u/v)_a 240 ! !! 241 ! !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. 242 ! !!---------------------------------------------------------------------- 243 ! INTEGER, INTENT( in ) :: kt ! time step 244 ! INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step 245 ! INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 246 ! ! 247 ! INTEGER :: ji, jj, jk ! dummy loop indices 248 ! INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 249 ! REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars 250 ! LOGICAL :: ll_do_bclinic ! local logical 251 ! REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 252 ! !!---------------------------------------------------------------------- 253 ! ! 254 ! IF( ln_linssh ) RETURN ! No calculation in linear free surface 255 ! ! 256 ! IF( ln_timing ) CALL timing_start('dom_qe_sf_nxt') 257 ! ! 258 ! IF( kt == nit000 ) THEN 259 ! IF(lwp) WRITE(numout,*) 260 ! IF(lwp) WRITE(numout,*) 'dom_qe_sf_nxt : compute after scale factors' 261 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 262 ! ENDIF 263 ! 264 ! 265 ! ! ******************************* ! 266 ! ! After acale factors at t-points ! 267 ! ! ******************************* ! 268 ! ! ! --------------------------------------------- ! 269 ! ! ! z_star coordinate and barotropic z-tilde part ! 270 ! ! ! --------------------------------------------- ! 271 ! ! 272 ! ! 273 ! ! *********************************** ! 274 ! ! After scale factors at u- v- points ! 275 ! ! *********************************** ! 276 ! ! 277 ! DO jk = 1, jpkm1 278 ! e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) ) 279 ! e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) ) 280 ! e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) ) 281 ! END DO 282 ! ! 283 ! ! *********************************** ! 284 ! ! After depths at u- v points ! 285 ! ! *********************************** ! 286 ! hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 287 ! hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 288 ! ! ! Inverse of the local depth 289 ! r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 290 ! r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 291 ! ! 292 ! IF( ln_timing ) CALL timing_stop('dom_qe_sf_nxt') 293 ! ! 294 ! END SUBROUTINE dom_qe_sf_nxt 295 !!st end 296 297 SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 225 298 !!---------------------------------------------------------------------- 226 299 !! *** ROUTINE dom_qe_sf_nxt *** 227 300 !! 228 !! ** Purpose : - compute the after scale factorsused in tra_zdf, dynnxt,301 !! ** Purpose : - compute the after water heigh used in tra_zdf, dynnxt, 229 302 !! tranxt and dynspg routines 230 303 !! 231 !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 232 !! 233 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 234 !! - tilde_e3t_a: after increment of vertical scale factor 235 !! in z_tilde case 236 !! - e3(t/u/v)_a 237 !! 238 !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. 304 !! ** Method : - z_star case: Proportionnaly to the water column thickness. 305 !! 306 !! ** Action : - h(u/v) update wrt ssh/h(u/v)_0 307 !! 239 308 !!---------------------------------------------------------------------- 240 309 INTEGER, INTENT( in ) :: kt ! time step … … 242 311 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 243 312 ! 244 INTEGER :: ji, jj, jk ! dummy loop indices245 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers246 REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars247 LOGICAL :: ll_do_bclinic ! local logical248 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv249 313 !!---------------------------------------------------------------------- 250 314 ! 251 315 IF( ln_linssh ) RETURN ! No calculation in linear free surface 252 316 ! 253 IF( ln_timing ) CALL timing_start('dom_ qe_sf_nxt')317 IF( ln_timing ) CALL timing_start('dom_h_nxt') 254 318 ! 255 319 IF( kt == nit000 ) THEN 256 320 IF(lwp) WRITE(numout,*) 257 IF(lwp) WRITE(numout,*) 'dom_ qe_sf_nxt : compute after scale factors'321 IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 258 322 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 259 323 ENDIF 260 261 262 ! ******************************* !263 ! After acale factors at t-points !264 ! ******************************* !265 ! ! --------------------------------------------- !266 ! ! z_star coordinate and barotropic z-tilde part !267 ! ! --------------------------------------------- !268 !269 !270 ! *********************************** !271 ! After scale factors at u- v- points !272 ! *********************************** !273 !274 DO jk = 1, jpkm1275 e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) )276 e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) )277 e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) )278 END DO279 324 ! 280 325 ! *********************************** ! … … 287 332 r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 288 333 ! 289 IF( ln_timing ) CALL timing_stop('dom_qe_sf_nxt')290 !291 END SUBROUTINE dom_qe_sf_nxt292 293 294 SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall )295 !!----------------------------------------------------------------------296 !! *** ROUTINE dom_qe_sf_nxt ***297 !!298 !! ** Purpose : - compute the after water heigh used in tra_zdf, dynnxt,299 !! tranxt and dynspg routines300 !!301 !! ** Method : - z_star case: Proportionnaly to the water column thickness.302 !!303 !! ** Action : - h(u/v) update wrt ssh/h(u/v)_0304 !!305 !!----------------------------------------------------------------------306 INTEGER, INTENT( in ) :: kt ! time step307 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step308 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence309 !310 !!----------------------------------------------------------------------311 !312 IF( ln_linssh ) RETURN ! No calculation in linear free surface313 !314 IF( ln_timing ) CALL timing_start('dom_h_nxt')315 !316 IF( kt == nit000 ) THEN317 IF(lwp) WRITE(numout,*)318 IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors'319 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'320 ENDIF321 !322 ! *********************************** !323 ! After depths at u- v points !324 ! *********************************** !325 hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) )326 hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) )327 ! ! Inverse of the local depth328 r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) )329 r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) )330 !331 334 IF( ln_timing ) CALL timing_stop('dom_h_nxt') 332 335 ! 333 336 END SUBROUTINE dom_h_nxt 334 337 335 336 SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 338 ! !!st 339 ! SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 340 ! !!---------------------------------------------------------------------- 341 ! !! *** ROUTINE dom_qe_sf_update *** 342 ! !! 343 ! !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 344 ! !! compute all depths and related variables for next time step 345 ! !! write outputs and restart file 346 ! !! 347 ! !! ** Method : - reconstruct scale factor at other grid points (interpolate) 348 ! !! - recompute depths and water height fields 349 ! !! 350 ! !! ** Action : - Recompute: 351 ! !! e3(u/v)_b 352 ! !! e3w(:,:,:,Kmm) 353 ! !! e3(u/v)w_b 354 ! !! e3(u/v)w_n 355 ! !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 356 ! !! h(u/v) and h(u/v)r 357 ! !! 358 ! !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 359 ! !! Leclair, M., and G. Madec, 2011, Ocean Modelling. 360 ! !!---------------------------------------------------------------------- 361 ! INTEGER, INTENT( in ) :: kt ! time step 362 ! INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 363 ! ! 364 ! INTEGER :: ji, jj, jk ! dummy loop indices 365 ! REAL(wp) :: zcoef ! local scalar 366 ! !!---------------------------------------------------------------------- 367 ! ! 368 ! IF( ln_linssh ) RETURN ! No calculation in linear free surface 369 ! ! 370 ! IF( ln_timing ) CALL timing_start('dom_qe_sf_update') 371 ! ! 372 ! IF( kt == nit000 ) THEN 373 ! IF(lwp) WRITE(numout,*) 374 ! IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 375 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 376 ! ENDIF 377 ! ! 378 ! ! Compute all missing vertical scale factor and depths 379 ! ! ==================================================== 380 ! ! Horizontal scale factor interpolations 381 ! ! -------------------------------------- 382 ! ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 383 ! ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 384 ! 385 ! 386 ! ! Scale factor computation 387 ! DO jk = 1, jpk ! Horizontal interpolation 388 ! e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) ! Kmm time level 389 ! ! ! Vertical interpolation 390 ! ! ! The ratio does not have to be masked at w-level 391 ! e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 392 ! e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 393 ! e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 394 ! e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 395 ! e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 396 ! e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 397 ! END DO 398 ! 399 ! 400 ! IF( ln_isf ) THEN !** IceShelF cavities 401 ! ! ! to be created depending of the new names in isf 402 ! ! ! it should be something like that : (with h_isf = thickness of iceshelf) 403 ! ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 404 ! !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 405 ! gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 406 ! gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 407 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 408 ! DO jk = 2, jpk 409 ! gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 410 ! + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 411 ! gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 412 ! + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 413 ! gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 414 ! gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 415 ! + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 416 ! gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 417 ! + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 418 ! END DO 419 ! ! 420 ! ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 421 ! ! 422 ! !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 423 ! DO jk = 1, jpk 424 ! gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 425 ! gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 426 ! gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 427 ! gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 428 ! gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 429 ! END DO 430 ! ! 431 ! ENDIF 432 ! 433 ! ! Local depth and Inverse of the local depth of the water 434 ! ! ------------------------------------------------------- 435 ! ! 436 ! ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 437 ! 438 ! ! write restart file 439 ! ! ================== 440 ! IF( lrst_oce ) CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' ) 441 ! ! 442 ! IF( ln_timing ) CALL timing_stop('dom_qe_sf_update') 443 ! ! 444 ! END SUBROUTINE dom_qe_sf_update 445 !!st end 446 447 SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa ) 337 448 !!---------------------------------------------------------------------- 338 449 !! *** ROUTINE dom_qe_sf_update *** … … 346 457 !! 347 458 !! ** Action : - Recompute: 348 !! e3(u/v)_b349 !! e3w(:,:,:,Kmm)350 !! e3(u/v)w_b351 !! e3(u/v)w_n352 459 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 353 460 !! h(u/v) and h(u/v)r … … 377 484 ! Horizontal scale factor interpolations 378 485 ! -------------------------------------- 379 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt380 486 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 381 382 383 ! Scale factor computation384 DO jk = 1, jpk ! Horizontal interpolation385 e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) ! Kmm time level386 ! ! Vertical interpolation387 ! ! The ratio does not have to be masked at w-level388 e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level389 e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) )390 e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) )391 e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level392 e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) )393 e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) )394 END DO395 396 487 397 488 IF( ln_isf ) THEN !** IceShelF cavities … … 399 490 ! ! it should be something like that : (with h_isf = thickness of iceshelf) 400 491 ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 401 !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask !492 !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 402 493 gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 403 494 gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all … … 417 508 ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 418 509 ! 419 !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask !510 !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 420 511 DO jk = 1, jpk 421 512 gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) … … 435 526 ! write restart file 436 527 ! ================== 437 IF( lrst_oce ) CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' )438 !439 528 IF( ln_timing ) CALL timing_stop('dom_qe_sf_update') 440 529 ! 441 END SUBROUTINE dom_ qe_sf_update530 END SUBROUTINE dom_h_update 442 531 443 532 … … 507 596 508 597 509 SUBROUTINE dom_qe_rst( kt, Kbb, Kmm, cdrw)598 SUBROUTINE qe_rst_read( kt, Kbb, Kmm ) 510 599 !!--------------------------------------------------------------------- 511 !! *** ROUTINE dom_qe_rst***512 !! 513 !! ** Purpose : Read or write VVL filein restart file600 !! *** ROUTINE qe_rst_read *** 601 !! 602 !! ** Purpose : Read ssh in restart file 514 603 !! 515 604 !! ** Method : use of IOM library 516 !! if the restart does not contain vertical scale factors, 517 !! they are set to the _0 values 518 !! if the restart does not contain vertical scale factors increments (z_tilde), 519 !! they are set to 0. 605 !! if the restart does not contain ssh, 606 !! it is set to the _0 values. 520 607 !!---------------------------------------------------------------------- 521 608 INTEGER , INTENT(in) :: kt ! ocean time-step 522 609 INTEGER , INTENT(in) :: Kbb, Kmm ! ocean time level indices 523 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag524 610 ! 525 611 INTEGER :: ji, jj, jk … … 527 613 !!---------------------------------------------------------------------- 528 614 ! 529 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise530 ! ! ===============531 615 IF( ln_rstart ) THEN !* Read the restart file 532 616 CALL rst_read_open ! open the restart file if necessary 533 CALL iom_get( numror, jpdom_autoglo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )534 617 ! 535 id1 = iom_varid( numror, ' e3t_b', ldstop = .FALSE. )536 id2 = iom_varid( numror, ' e3t_n', ldstop = .FALSE. )618 id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 619 id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 537 620 ! 538 621 ! ! --------- ! … … 541 624 ! 542 625 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 543 CALL iom_get( numror, jpdom_autoglo, ' e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios)544 CALL iom_get( numror, jpdom_autoglo, ' e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios)626 CALL iom_get( numror, jpdom_autoglo, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios ) 627 CALL iom_get( numror, jpdom_autoglo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 545 628 ! needed to restart if land processor not computed 546 IF(lwp) write(numout,*) ' dom_qe_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files'547 WHERE ( tmask(:,:,:) == 0.0_wp )548 e3t(:,:,:,Kmm) = e3t_0(:,:,:)549 e3t(:,:,:,Kbb) = e3t_0(:,:,:)629 IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 630 WHERE ( ssmask(:,:) == 0.0_wp ) !!gm/st ==> sm should not be necessary on ssh when it was required on e3 631 ssh(:,:,Kmm) = 0._wp 632 ssh(:,:,Kbb) = 0._wp 550 633 END WHERE 551 634 IF( neuler == 0 ) THEN 552 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)635 ssh(:,:,Kbb) = ssh(:,:,Kmm) 553 636 ENDIF 554 637 ELSE IF( id1 > 0 ) THEN 555 IF(lwp) write(numout,*) ' dom_qe_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'556 IF(lwp) write(numout,*) ' e3t_n set equal to e3t_b.'638 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 639 IF(lwp) write(numout,*) 'sshn set equal to sshb.' 557 640 IF(lwp) write(numout,*) 'neuler is forced to 0' 558 CALL iom_get( numror, jpdom_autoglo, ' e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )559 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)641 CALL iom_get( numror, jpdom_autoglo, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 642 ssh(:,:,Kmm) = ssh(:,:,Kbb) 560 643 neuler = 0 561 644 ELSE IF( id2 > 0 ) THEN 562 IF(lwp) write(numout,*) ' dom_qe_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'563 IF(lwp) write(numout,*) ' e3t_b set equal to e3t_n.'645 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 646 IF(lwp) write(numout,*) 'sshb set equal to sshn.' 564 647 IF(lwp) write(numout,*) 'neuler is forced to 0' 565 CALL iom_get( numror, jpdom_autoglo, ' e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )566 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)648 CALL iom_get( numror, jpdom_autoglo, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 649 ssh(:,:,Kbb) = ssh(:,:,Kmm) 567 650 neuler = 0 568 651 ELSE 569 IF(lwp) write(numout,*) ' dom_qe_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'570 IF(lwp) write(numout,*) ' Compute scale factor from sshn'652 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 653 IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 571 654 IF(lwp) write(numout,*) 'neuler is forced to 0' 572 DO jk = 1, jpk 573 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 574 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 575 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 576 END DO 577 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 655 ssh(:,:,:) = 0._wp 578 656 neuler = 0 579 657 ENDIF … … 583 661 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 584 662 ! 585 IF( cn_cfg == 'wad' ) THEN 586 ! Wetting and drying test case 663 IF( cn_cfg == 'wad' ) THEN ! Wetting and drying test case 587 664 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 588 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 589 ssh (:,:,Kmm) = ssh(:,:,Kbb) 590 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 591 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 592 ELSE 593 ! if not test case 665 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 666 ssh(:,: ,Kmm) = ssh(:,: ,Kbb) 667 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 668 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 669 ELSE ! if not test case 594 670 ssh(:,:,Kmm) = -ssh_ref 595 671 ssh(:,:,Kbb) = -ssh_ref 596 672 ! 597 673 DO_2D_11_11 598 674 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth … … 601 677 ENDIF 602 678 END_2D 603 ENDIF !If test case else 604 605 ! Adjust vertical metrics for all wad 606 DO jk = 1, jpk 607 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) 608 END DO 609 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 679 ENDIF 610 680 611 681 DO ji = 1, jpi 612 682 DO jj = 1, jpj 613 683 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 614 CALL ctl_stop( ' dom_qe_rst: ht_0 must be positive at potentially wet points' )684 CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 615 685 ENDIF 616 686 END DO … … 623 693 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 624 694 ! ! 625 ! DO jk=1,jpk 626 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 627 ! & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 628 ! END DO 629 ! e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 630 ssh(:,:,Kmm)=0._wp 631 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 632 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 695 ssh(:,:,:) = 0._wp 633 696 ! 634 697 ENDIF ! end of ll_wd edits 635 698 ! 636 699 ENDIF 637 ! 638 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 639 ! ! =================== 640 IF(lwp) WRITE(numout,*) '---- dom_qe_rst ----' 641 IF( lwxios ) CALL iom_swap( cwxios_context ) 642 ! ! --------- ! 643 ! ! all cases ! 644 ! ! --------- ! 645 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 646 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 647 ! 648 IF( lwxios ) CALL iom_swap( cxios_context ) 649 ENDIF 650 ! 651 END SUBROUTINE dom_qe_rst 700 ! 701 END SUBROUTINE qe_rst_read 652 702 653 703 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domvvl.F90
r12482 r12680 12 12 !!---------------------------------------------------------------------- 13 13 14 !!----------------------------------------------------------------------15 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness16 !! dom_vvl_sf_nxt : Compute next vertical scale factors17 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid18 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another19 !! dom_vvl_rst : read/write restart file20 !! dom_vvl_ctl : Check the vvl options21 !!----------------------------------------------------------------------22 14 USE oce ! ocean dynamics and tracers 23 15 USE phycst ! physical constant … … 36 28 IMPLICIT NONE 37 29 PRIVATE 38 39 PUBLIC dom_vvl_init ! called by domain.F90 40 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 41 PUBLIC dom_vvl_sf_nxt ! called by step.F90 42 PUBLIC dom_vvl_sf_update ! called by step.F90 43 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 44 30 45 31 ! !!* Namelist nam_vvl 46 32 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate … … 64 50 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 65 51 52 #if defined key_qco 53 !!---------------------------------------------------------------------- 54 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 55 !!---------------------------------------------------------------------- 56 #else 57 !!---------------------------------------------------------------------- 58 !! Default key Old management of time varying vertical coordinate 59 !!---------------------------------------------------------------------- 60 61 !!---------------------------------------------------------------------- 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness 63 !! dom_vvl_sf_nxt : Compute next vertical scale factors 64 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 65 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 66 !! dom_vvl_rst : read/write restart file 67 !! dom_vvl_ctl : Check the vvl options 68 !!---------------------------------------------------------------------- 69 70 PUBLIC dom_vvl_init ! called by domain.F90 71 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 72 PUBLIC dom_vvl_sf_nxt ! called by step.F90 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 66 76 !! * Substitutions 67 77 # include "do_loop_substitute.h90" … … 136 146 ! 137 147 END SUBROUTINE dom_vvl_init 138 ! 148 149 139 150 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 140 151 !!---------------------------------------------------------------------- … … 1039 1050 END SUBROUTINE dom_vvl_ctl 1040 1051 1052 #endif 1053 1041 1054 !!====================================================================== 1042 1055 END MODULE domvvl -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90
r12656 r12680 12 12 !!---------------------------------------------------------------------- 13 13 #if defined key_qco 14 # define e3t(i,j,k,t) (e3t_0(i,j,k)*(1. +r3t(i,j,t)*tmask(i,j,k)))15 # define e3u(i,j,k,t) (e3u_0(i,j,k)*(1. +r3u(i,j,t)*umask(i,j,k)))16 # define e3v(i,j,k,t) (e3v_0(i,j,k)*(1. +r3v(i,j,t)*vmask(i,j,k)))17 # define e3f(i,j,k) (e3f_0(i,j,k)*(1. +r3f(i,j)*fmask(i,j,k)))18 # define e3w(i,j,k,t) (e3w_0(i,j,k)*(1. +r3t(i,j,t)))19 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1. +r3u(i,j,t)))20 # define e3vw(i,j,k,t) (e3vw_0(i,j,k)*(1. +r3v(i,j,t)))14 # define e3t(i,j,k,t) (e3t_0(i,j,k)*(1._wp+r3t(i,j,t)*tmask(i,j,k))) 15 # define e3u(i,j,k,t) (e3u_0(i,j,k)*(1._wp+r3u(i,j,t)*umask(i,j,k))) 16 # define e3v(i,j,k,t) (e3v_0(i,j,k)*(1._wp+r3v(i,j,t)*vmask(i,j,k))) 17 # define e3f(i,j,k) (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fmask(i,j,k))) 18 # define e3w(i,j,k,t) (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 19 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 20 # define e3vw(i,j,k,t) (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 21 21 #endif 22 22 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90
r12377 r12680 43 43 !! * Substitutions 44 44 # include "do_loop_substitute.h90" 45 # include "domzgr_substitute.h90" 45 46 !!---------------------------------------------------------------------- 46 47 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf.F90
r12581 r12680 58 58 59 59 PUBLIC dyn_atf ! routine called by step.F90 60 61 #if defined key_qco 62 !!---------------------------------------------------------------------- 63 !! 'key_qco' EMPTY ROUTINE Quasi-Eulerian vertical coordonate 64 !!---------------------------------------------------------------------- 65 CONTAINS 66 67 SUBROUTINE dyn_atf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 68 INTEGER , INTENT(in ) :: kt ! ocean time-step index 69 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! before and after time level indices 70 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities to be time filtered 71 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 72 73 WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt 74 END SUBROUTINE dyn_atf 75 76 #else 60 77 61 78 !! * Substitutions … … 314 331 END SUBROUTINE dyn_atf 315 332 333 #endif 334 316 335 !!========================================================================= 317 336 END MODULE dynatf -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/sshwzv.F90
r12622 r12680 114 114 ! 115 115 #if defined key_agrif 116 Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt ) 116 Kbb_a = Kbb ; Kmm_a = Kmm ; Krhs_a = Kaa 117 CALL agrif_ssh( kt ) 117 118 #endif 118 119 ! … … 134 135 135 136 136 SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa)137 SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww ) 137 138 !!---------------------------------------------------------------------- 138 139 !! *** ROUTINE wzv *** … … 151 152 INTEGER , INTENT(in) :: kt ! time step 152 153 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 153 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! now vertical velocity154 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! vertical velocity at Kmm 154 155 ! 155 156 INTEGER :: ji, jj, jk ! dummy loop indices … … 165 166 IF(lwp) WRITE(numout,*) '~~~~~ ' 166 167 ! 167 pww(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 168 ENDIF 169 ! !------------------------------! 170 ! ! Now Vertical Velocity ! 171 ! !------------------------------! 172 z1_2dt = 1. / ( 2. * rdt ) ! set time step size (Euler/Leapfrog) 168 pww(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 169 ENDIF 170 ! 171 z1_2dt = 1. / ( 2. * rdt ) ! set time step size (Euler/Leapfrog) 173 172 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1. / rdt 174 173 ! 175 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 174 ! !===============================! 175 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN !== z_tilde and layer cases ==! 176 ! !===============================! 176 177 ALLOCATE( zhdiv(jpi,jpj,jpk) ) 177 178 ! … … 188 189 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 189 190 ! computation of w 190 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk)&191 & + zhdiv(:,:,jk)&192 & + z1_2dt * ( e3t(:,:,jk,Kaa)&193 & - e3t(:,:,jk,Kbb) )) * tmask(:,:,jk)191 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 192 & + zhdiv(:,:,jk) & 193 & + z1_2dt * ( e3t(:,:,jk,Kaa) & 194 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 194 195 END DO 195 196 ! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 196 197 DEALLOCATE( zhdiv ) 197 ELSE ! z_star and linear free surface cases 198 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 199 ! computation of w 198 ! !=================================! 199 ELSEIF( ln_linssh ) THEN !== linear free surface cases ==! 200 ! !=================================! 201 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 202 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) ) * tmask(:,:,jk) 203 END DO 204 ! !==========================================! 205 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 206 ! !==========================================! 207 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 200 208 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 201 209 & + z1_2dt * ( e3t(:,:,jk,Kaa) & -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/IOM/restart.F90
r12377 r12680 285 285 ! 286 286 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 287 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 288 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm) 289 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm) 290 ssh (:,: ,Kbb) = ssh (:,: ,Kmm) 291 ! 292 IF( .NOT.ln_linssh ) THEN 293 DO jk = 1, jpk 294 e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 295 END DO 296 ENDIF 297 ! 287 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values 288 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm) 289 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm) 290 ssh(:,: ,Kbb) = ssh(:,: ,Kmm) 298 291 ENDIF 299 292 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90
r12656 r12680 226 226 #if ! defined key_qco 227 227 DO jk = 1, jpk 228 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 229 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 230 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 228 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + (ht_0(:,:) + ssh(:,:,Kmm)) * r1_ht_0(:,:) ) 231 229 END DO 232 230 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90
r12656 r12680 239 239 ! 240 240 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 241 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)* tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )242 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)* tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )243 END DO241 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*r1_ht_0(:,:)*tmask(:,:,jk) ) 242 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*r1_ht_0(:,:)*tmask(:,:,jk) ) 243 END DO 244 244 e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 245 245 ! Reconstruction of all vertical scale factors at now and before time-steps -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatf.F90
r12656 r12680 132 132 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 133 133 DO jk = 1, jpkm1 134 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) & 135 & / e3t(:,:,jk,Kmm) & 136 & - pts(:,:,jk,jp_tem,Kmm)) * zfact 137 ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) & 138 & / e3t(:,:,jk,Kmm) & 139 & - pts(:,:,jk,jp_sal,Kmm)) * zfact 134 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 135 ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 140 136 END DO 141 137 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 336 332 IF ( jk == misfkb_cav(ji,jj) ) THEN 337 333 ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) & 338 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) & 339 & * rfrac_tbl_cav(ji,jj) 334 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj) 340 335 END IF 341 336 END IF … … 351 346 IF ( jk == misfkb_par(ji,jj) ) THEN 352 347 ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) & 353 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) & 354 & * rfrac_tbl_par(ji,jj) 348 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj) 355 349 END IF 356 350 END IF -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/step.F90
r12377 r12680 33 33 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 34 34 !!---------------------------------------------------------------------- 35 35 #if defined key_qco 36 !!---------------------------------------------------------------------- 37 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 38 !!---------------------------------------------------------------------- 39 #else 36 40 !!---------------------------------------------------------------------- 37 41 !! stp : OPA system time-stepping … … 171 175 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 172 176 IF( .NOT.ln_linssh ) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 173 CALL wzv ( kstp, Nbb, Nnn, ww, Naa) ! now cross-level velocity177 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! now cross-level velocity 174 178 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 175 179 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) ) ! now in situ density for hpg computation … … 200 204 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion 201 205 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 202 CALL wzv ( kstp, Nbb, Nnn, ww, Naa) ! now cross-level velocity206 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! now cross-level velocity 203 207 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 204 208 ENDIF … … 339 343 END SUBROUTINE stp 340 344 ! 345 #endif 341 346 !!====================================================================== 342 347 END MODULE step -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90
r12679 r12680 55 55 !!---------------------------------------------------------------------- 56 56 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !! used by nemo_init 57 58 57 # include "domzgr_substitute.h90" 59 58 !!---------------------------------------------------------------------- … … 185 184 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 186 185 187 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor)186 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 188 187 IF( .NOT.ln_linssh ) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 189 IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors188 IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 190 189 !IF( .NOT.ln_linssh ) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 191 CALL wzv ( kstp, Nbb, Nnn, ww, Naa ) ! nowcross-level velocity190 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 192 191 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 193 192 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn) ) ! now in situ density for hpg computation … … 213 212 ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 214 213 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 215 CALL div_hor 216 IF(.NOT.ln_linssh) CALL dom_qe_r3c 217 IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component)218 !IF(.NOT.ln_linssh) CALL dom_h_nxt( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component)214 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) 215 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 216 !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 217 IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 219 218 ENDIF 220 219 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion 221 220 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 222 CALL wzv ( kstp, Nbb, Nnn, ww, Naa ) ! nowcross-level velocity221 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 223 222 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 224 223 ENDIF … … 294 293 !! place. 295 294 !! 296 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 297 CALL zdyn_ts ( Nnn, Naa, e3u, e3v, uu, vv ) ! barotrope ajustment 295 CALL zdyn_ts ( Nnn, Naa, uu, vv ) ! barotrope ajustment 298 296 CALL finalize_sbc ( kstp, Nbb, Naa, uu, vv, ts ) ! boundary condifions 299 297 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 300 298 CALL dom_qe_r3c ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 301 299 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 302 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities and scale factors300 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities and scale factors 303 301 r3t(:,:,Nnn) = r3t_f(:,:) 304 302 r3u(:,:,Nnn) = r3u_f(:,:) … … 312 310 Naa = Nrhs 313 311 ! 314 IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 312 !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 313 IF(.NOT.ln_linssh) CALL dom_h_update ( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 315 314 ! 316 315 IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics … … 367 366 368 367 369 SUBROUTINE zdyn_ts (Kmm, Kaa, p e3u, pe3v, puu, pvv)368 SUBROUTINE zdyn_ts (Kmm, Kaa, puu, pvv) 370 369 !!---------------------------------------------------------------------- 371 370 !! *** ROUTINE zdyn_ts *** … … 380 379 INTEGER , INTENT(in ) :: Kmm, Kaa ! before and after time level indices 381 380 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities 382 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in ) :: pe3u, pe3v ! scale factors383 381 ! 384 382 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve … … 391 389 ! Ensure below that barotropic velocities match time splitting estimate 392 390 ! Compute actual transport and replace it with ts estimate at "after" time step 393 zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)394 zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)391 zue(:,:) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 392 zve(:,:) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 395 393 DO jk = 2, jpkm1 396 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)397 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)394 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 395 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 398 396 END DO 399 397 DO jk = 1, jpkm1 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/C14/trcsms_c14.F90
r12377 r12680 28 28 !! * Substitutions 29 29 # include "do_loop_substitute.h90" 30 # include "domzgr_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/CFC/trcsms_cfc.F90
r12377 r12680 49 49 !! * Substitutions 50 50 # include "do_loop_substitute.h90" 51 # include "domzgr_substitute.h90" 51 52 !!---------------------------------------------------------------------- 52 53 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zbio.F90
r12377 r12680 58 58 !! * Substitutions 59 59 # include "do_loop_substitute.h90" 60 # include "domzgr_substitute.h90" 60 61 !!---------------------------------------------------------------------- 61 62 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zexp.F90
r12377 r12680 39 39 !! * Substitutions 40 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zopt.F90
r12377 r12680 40 40 !! * Substitutions 41 41 # include "do_loop_substitute.h90" 42 # include "domzgr_substitute.h90" 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P2Z/p2zsed.F90
r12377 r12680 33 33 !! * Substitutions 34 34 # include "do_loop_substitute.h90" 35 # include "domzgr_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zbc.F90
r12377 r12680 48 48 !! * Substitutions 49 49 # include "do_loop_substitute.h90" 50 # include "domzgr_substitute.h90" 50 51 !!---------------------------------------------------------------------- 51 52 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zflx.F90
r12377 r12680 54 54 !! * Substitutions 55 55 # include "do_loop_substitute.h90" 56 # include "domzgr_substitute.h90" 56 57 !!---------------------------------------------------------------------- 57 58 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zopt.F90
r12377 r12680 44 44 !! * Substitutions 45 45 # include "do_loop_substitute.h90" 46 # include "domzgr_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zpoc.F90
r12377 r12680 39 39 !! * Substitutions 40 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zrem.F90
r12377 r12680 44 44 !! * Substitutions 45 45 # include "do_loop_substitute.h90" 46 # include "domzgr_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsed.F90
r12377 r12680 39 39 !! * Substitutions 40 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsms.F90
r12377 r12680 41 41 !! * Substitutions 42 42 # include "do_loop_substitute.h90" 43 # include "domzgr_substitute.h90" 43 44 !!---------------------------------------------------------------------- 44 45 !! NEMO/TOP 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/oce_sed.F90
r12377 r12680 13 13 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 14 14 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 15 15 !!st USE dom_oce , ONLY : e3t => e3t !: latitude of t-point (degre) 16 16 USE dom_oce , ONLY : e3t_1d => e3t_1d !: reference depth of t-points (m) 17 17 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of t-points (m) … … 53 53 54 54 END MODULE oce_sed 55 56 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/seddta.F90
r12377 r12680 24 24 !! * Substitutions 25 25 # include "do_loop_substitute.h90" 26 # include "domzgr_substitute.h90" 26 27 !! $Id$ 27 28 CONTAINS … … 164 165 CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 165 166 rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 166 ! vector temperature [ °C] and salinity167 ! vector temperature [�C] and salinity 167 168 CALL pack_arr ( jpoce, temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 168 169 CALL pack_arr ( jpoce, salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcsink.F90
r12377 r12680 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/TOP 4.0 , NEMO Consortium (2018)
Note: See TracChangeset
for help on using the changeset viewer.