- Timestamp:
- 2020-11-27T00:30:21+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domvvl.F90
r13874 r13895 787 787 !! ** Purpose : Read or write VVL file in restart file 788 788 !! 789 !! ** Method : use of IOM library 790 !! if the restart does not contain vertical scale factors, 791 !! they are set to the _0 values 792 !! if the restart does not contain vertical scale factors increments (z_tilde), 793 !! they are set to 0. 789 !! ** Method : * restart comes from a linear ssh simulation : 790 !! an attempt to read e3t_n stops simulation 791 !! * restart comes from a z-star, z-tilde, or layer : 792 !! read e3t_n and e3t_b 793 !! * restart comes from a z-star : 794 !! set tilde_e3t_n, tilde_e3t_n, and hdiv_lf to 0 795 !! * restart comes from layer : 796 !! read tilde_e3t_n and tilde_e3t_b 797 !! set hdiv_lf to 0 798 !! * restart comes from a z-tilde: 799 !! read tilde_e3t_n, tilde_e3t_b, and hdiv_lf 800 !! 801 !! NB: if l_1st_euler = T (ln_1st_euler or ssh_b not found) 802 !! Kbb fields set to Kmm ones 794 803 !!---------------------------------------------------------------------- 795 804 INTEGER , INTENT(in) :: kt ! ocean time-step … … 797 806 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 798 807 ! 799 INTEGER :: ji, jj, jk 800 INTEGER :: id1, id2, id3, id4, id5 ! local integers 801 !!---------------------------------------------------------------------- 802 ! 803 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 804 ! ! =============== 805 IF( ln_rstart ) THEN !* Read the restart file 806 CALL rst_read_open ! open the restart file if necessary 808 INTEGER :: ji, jj, jk ! dummy loop indices 809 INTEGER :: id3, id4, id5 ! local integers 810 !!---------------------------------------------------------------------- 811 ! 812 ! !=====================! 813 IF( TRIM(cdrw) == 'READ' ) THEN ! Read / initialise ! 814 ! !=====================! 815 ! 816 IF( ln_rstart ) THEN !== Read the restart file ==! 807 817 ! 808 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 809 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 810 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 818 CALL rst_read_open !* open the restart file if necessary 819 ! ! --------- ! 820 ! ! all cases ! 821 ! ! --------- ! 822 ! 823 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) !* check presence 811 824 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 812 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. )825 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. ) 813 826 ! 814 ! ! --------- ! 815 ! ! all cases ! 816 ! ! --------- ! 817 ! 818 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 827 ! !* scale factors 828 IF(lwp) WRITE(numout,*) ' Kmm scale factor read in the restart file' 829 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 830 WHERE ( tmask(:,:,:) == 0.0_wp ) 831 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 832 END WHERE 833 IF( l_1st_euler ) THEN ! euler 834 IF(lwp) WRITE(numout,*) ' Euler first time step : e3t(Kbb) = e3t(Kmm)' 835 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 836 ELSE ! leap frog 837 IF(lwp) WRITE(numout,*) ' Kbb scale factor read in the restart file' 819 838 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 820 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )821 ! needed to restart if land processor not computed822 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files'823 839 WHERE ( tmask(:,:,:) == 0.0_wp ) 824 e3t(:,:,:,Kmm) = e3t_0(:,:,:)825 840 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 826 841 END WHERE 827 IF( l_1st_euler ) THEN828 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)829 ENDIF830 ELSE IF( id1 > 0 ) THEN831 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'832 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'833 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'834 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )835 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)836 l_1st_euler = .true.837 ELSE IF( id2 > 0 ) THEN838 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'839 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'840 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'841 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )842 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)843 l_1st_euler = .true.844 ELSE845 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'846 IF(lwp) write(numout,*) 'Compute scale factor from sshn'847 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'848 DO jk = 1, jpk849 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &850 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &851 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk))852 END DO853 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)854 l_1st_euler = .true.855 842 ENDIF 856 ! !----------- !857 IF( ln_vvl_zstar ) THEN !z_star case !858 ! !----------- !843 ! ! ------------ ! 844 IF( ln_vvl_zstar ) THEN ! z_star case ! 845 ! ! ------------ ! 859 846 IF( MIN( id3, id4 ) > 0 ) THEN 860 847 CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' ) 861 848 ENDIF 862 ! ! ----------------------- ! 863 ELSE ! z_tilde and layer cases ! 864 ! ! ----------------------- ! 865 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 849 ! ! ------------------------ ! 850 ELSE ! z_tilde and layer cases ! 851 ! ! ------------------------ ! 852 ! 853 IF( id4 > 0 ) THEN !* scale factor increments 854 IF(lwp) WRITE(numout,*) ' Kmm scale factor increments read in the restart file' 867 855 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 868 ELSE ! one at least array is missing 856 IF( l_1st_euler ) THEN ! euler 857 IF(lwp) WRITE(numout,*) ' Euler first time step : tilde_e3t(Kbb) = tilde_e3t(Kmm)' 858 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 859 ELSE ! leap frog 860 IF(lwp) WRITE(numout,*) ' Kbb scale factor increments read in the restart file' 861 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 862 ENDIF 863 ELSE 869 864 tilde_e3t_b(:,:,:) = 0.0_wp 870 865 tilde_e3t_n(:,:,:) = 0.0_wp 871 866 ENDIF 872 ! ! ------------ !873 IF( ln_vvl_ztilde ) THEN ! z_tilde case !874 ! ! ------------ !867 ! ! ------------ ! 868 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 869 ! ! ------------ ! 875 870 IF( id5 > 0 ) THEN ! required array exists 876 871 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 877 872 ELSE ! array is missing 878 hdiv_lf(:,:,:) = 0.0_wp 873 hdiv_lf(:,:,:) = 0.0_wp 879 874 ENDIF 880 875 ENDIF 881 876 ENDIF 882 877 ! 883 ELSE ! * Initialize at "rest" with ssh878 ELSE !== Initialize at "rest" with ssh ==! 884 879 ! 885 880 DO jk = 1, jpk 886 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) / ( ht_0(:,:) + 1._wp - ssmask(:,:)) * tmask(:,:,jk) )881 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 887 882 END DO 888 883 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) … … 892 887 tilde_e3t_n(:,:,:) = 0._wp 893 888 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 894 END IF 895 ENDIF 896 ! 897 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 898 ! ! =================== 889 ENDIF 890 ENDIF 891 ! !=======================! 892 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file ! 893 ! !=======================! 894 ! 899 895 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 900 896 IF( lwxios ) CALL iom_swap( cwxios_context )
Note: See TracChangeset
for help on using the changeset viewer.
