Changeset 4578 for branches/2012
- Timestamp:
- 2014-03-26T10:02:56+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynspg_flt_tam.F90
r3611 r4578 46 46 USE dom_oce 47 47 USE solver 48 USE dynspg_flt 48 49 USE sol_oce 49 50 USE oce_tam … … 63 64 USE lib_fortran 64 65 USE timing 66 USE iom 65 67 66 68 … … 149 151 spgu_tl(:,:) = 0.0_wp ! surface pressure gradient (i-direction) 150 152 spgv_tl(:,:) = 0.0_wp ! surface pressure gradient (j-direction) 151 !CALL solver_init( nit000 ) ! Elliptic solver initialisation 153 ! Reinitialize the solver arrays 154 gcxb_tl(:,:) = 0.e0 155 gcx_tl (:,:) = 0.e0 156 CALL sol_mat( nit000 ) 152 157 ENDIF 153 158 ! Local constant initialization … … 168 173 END DO 169 174 END DO 175 170 176 DO jk = 1, jpkm1 ! unweighted time stepping 171 177 DO jj = 2, jpjm1 … … 236 242 END DO 237 243 END DO 244 238 245 ! apply the lateral boundary conditions 239 246 IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 ) CALL lbc_lnk_e( gcb_tl, c_solver_pt, 1.0_wp ) … … 291 298 END DO 292 299 END DO 300 293 301 ! 294 302 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_flt_tan') … … 370 378 CALL sol_mat(kt) ! initialize matrix 371 379 372 ELSEIF ( neuler == 0 .AND. kt == nit000 + 1) THEN380 ELSEIF ( kt == nitend ) THEN 373 381 374 382 z2dt = 2.0_wp * rdt ! time step: leap-frog 375 383 CALL sol_mat(kt) ! reinitialize matrix 376 384 377 ELSE IF ( kt == nitend ) THEN385 ELSE 378 386 379 387 z2dt = 2.0_wp * rdt ! time step: leap-frog 380 CALL sol_mat(kt) ! reinitialize matrix381 382 ELSEIF ( neuler /= 0 .AND. kt == nit000 ) THEN383 384 z2dt = 2.0_wp * rdt ! time step: leap-frog385 CALL sol_mat(kt) ! initialize matrix386 387 ELSE388 389 z2dt = 2.0_wp * rdt ! time step: leap-frog390 388 391 389 ENDIF 392 390 393 391 z2dtg = grav * z2dt 392 393 ! set to zero free surface specific arrays (they are actually local variables) 394 spgu_ad(:,:) = 0.0_wp ; spgv_ad(:,:) = 0.0_wp 394 395 395 396 ! Add the trends multiplied by z2dt to the after velocity … … 546 547 ua_ad( ji,jj,jk) = ua_ad(ji,jj,jk) * umask(ji,jj,jk) 547 548 ub_ad( ji,jj,jk) = ub_ad(ji,jj,jk) + ua_ad(ji,jj,jk) 548 spgu_ad(ji,jj ) = spgu_ad(ji,jj) + ua_ad(ji,jj,jk) * z2dt549 549 ua_ad( ji,jj,jk) = ua_ad(ji,jj,jk) * z2dt 550 spgu_ad(ji,jj ) = spgu_ad(ji,jj) + ua_ad(ji,jj,jk) 550 551 va_ad( ji,jj,jk) = va_ad(ji,jj,jk) * vmask(ji,jj,jk) 551 552 vb_ad( ji,jj,jk) = vb_ad(ji,jj,jk) + va_ad(ji,jj,jk) 552 spgv_ad(ji,jj ) = spgv_ad(ji,jj) + va_ad(ji,jj,jk) * z2dt553 553 va_ad( ji,jj,jk) = va_ad(ji,jj,jk) * z2dt 554 spgv_ad(ji,jj ) = spgv_ad(ji,jj) + va_ad(ji,jj,jk) 554 555 END DO 555 556 END DO … … 573 574 spgu_ad(:,:) = 0.0_wp ! surface pressure gradient (i-direction) 574 575 spgv_ad(:,:) = 0.0_wp ! surface pressure gradient (j-direction) 576 ! Reinitialize the solver arrays 577 gcxb_ad(:,:) = 0.e0 578 gcx_ad (:,:) = 0.e0 575 579 ENDIF 576 580 ! … … 615 619 & zua_tlout, & ! Tangent output: ua_tl 616 620 & zva_tlout, & ! Tangent output: va_tl 617 & zub_tlout, & ! Tangent output: ua_tl618 & zvb_tlout, & ! Tangent output: va_tl619 & zub_adin, & ! Tangent output: ua_ad620 & zvb_adin, & ! Tangent output: va_ad621 621 & zua_adin, & ! Adjoint input: ua_ad 622 622 & zva_adin, & ! Adjoint input: va_ad … … 628 628 629 629 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 630 & zgcx_tlin, zgcxb_tlin, zgcb_tlin, zgcx_tlout, zgcxb_tlout, zgcb_tlout, & 631 & zgcx_adin, zgcxb_adin, zgcb_adin, zgcx_adout, zgcxb_adout, zgcb_adout, & 632 & zspgu_tlout, zspgv_tlout, zspgu_adin, zspgv_adin 630 & zgcx_tlin, zgcxb_tlin, zgcx_tlout, zgcxb_tlout, & 631 & zgcx_adin, zgcxb_adin, zgcx_adout, zgcxb_adout 633 632 634 633 REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 635 634 & zsshn_tlin, & ! Tangent input: sshn_tl 636 635 & zsshn_adout,& ! Adjoint output: sshn_ad 637 & zemp_tlin, & ! Tangent input: emp_tl638 & zemp_adout, & ! Adjoint output: emp_ad639 636 & znssh ! 2D random field for SSH 640 637 REAL(wp) :: & … … 654 651 INTEGER :: & 655 652 & jpert 656 INTEGER, PARAMETER :: jpertmax = 7653 INTEGER, PARAMETER :: jpertmax = 6 657 654 658 655 ! Allocate memory … … 676 673 & zsshn_tlin(jpi,jpj), & 677 674 & zsshn_adout(jpi,jpj),& 678 & zemp_tlin(jpi,jpj), &679 & zemp_adout(jpi,jpj), &680 675 & znssh(jpi,jpj) & 681 676 & ) 682 677 683 678 ALLOCATE( zgcx_tlin (jpi,jpj), zgcx_tlout (jpi,jpj), zgcx_adin (jpi,jpj), zgcx_adout (jpi,jpj), & 684 zgcxb_tlin(jpi,jpj), zgcxb_tlout(jpi,jpj), zgcxb_adin(jpi,jpj), zgcxb_adout(jpi,jpj), & 685 zgcb_tlin (jpi,jpj), zgcb_tlout (jpi,jpj), zgcb_adin (jpi,jpj), zgcb_adout (jpi,jpj) & 686 & ) 687 688 ALLOCATE ( zub_tlout(jpi,jpj,jpk), zvb_tlout(jpi,jpj,jpk), & 689 zub_adin (jpi,jpj,jpk), zvb_adin (jpi,jpj,jpk) ) 690 691 ALLOCATE( zspgu_tlout (jpi,jpj), zspgv_tlout (jpi,jpj), zspgu_adin (jpi,jpj), zspgv_adin (jpi,jpj)) 679 zgcxb_tlin(jpi,jpj), zgcxb_tlout(jpi,jpj), zgcxb_adin(jpi,jpj), zgcxb_adout(jpi,jpj) ) 692 680 693 681 !========================================================================= … … 698 686 ! Test for time steps nit000 and nit000 + 1 (the matrix changes) 699 687 700 DO jstp = nit000, nit 000 + 1701 DO jpert = 1, jpertmax688 DO jstp = nit000, nitend, nitend-nit000 689 DO jpert = jpertmax, jpertmax 702 690 istp = jstp 703 691 … … 720 708 721 709 zsshn_tlin (:,:) = 0.0_wp 722 zemp_tlin (:,:) = 0.0_wp723 710 zsshn_adout(:,:) = 0.0_wp 724 zemp_adout (:,:) = 0.0_wp725 zspgu_adin (:,:) = 0.0_wp726 zspgv_adin (:,:) = 0.0_wp727 zspgu_tlout(:,:) = 0.0_wp728 zspgv_tlout(:,:) = 0.0_wp729 711 730 712 zgcx_tlout (:,:) = 0.0_wp ; zgcx_adin (:,:) = 0.0_wp ; zgcx_adout (:,:) = 0.0_wp 731 713 zgcxb_tlout(:,:) = 0.0_wp ; zgcxb_adin(:,:) = 0.0_wp ; zgcxb_adout(:,:) = 0.0_wp 732 zgcb_tlout (:,:) = 0.0_wp ; zgcb_adin (:,:) = 0.0_wp ; zgcb_adout (:,:) = 0.0_wp733 714 734 715 ub_tl(:,:,:) = 0.0_wp … … 737 718 va_tl(:,:,:) = 0.0_wp 738 719 sshn_tl(:,:) = 0.0_wp 739 emp_tl(:,:) = 0.0_wp740 gcb_tl(:,:) = 0.0_wp741 720 gcx_tl(:,:) = 0.0_wp 742 721 gcxb_tl(:,:) = 0.0_wp … … 748 727 va_ad(:,:,:) = 0.0_wp 749 728 sshn_ad(:,:) = 0.0_wp 750 emp_ad(:,:) = 0.0_wp751 729 gcb_ad(:,:) = 0.0_wp 752 730 gcx_ad(:,:) = 0.0_wp … … 807 785 ENDIF 808 786 IF ( (jpert == 5) .OR. (jpert == jpertmax) ) THEN 809 CALL grid_random( znssh, 'T', 0.0_wp, stdemp ) 810 811 DO jj = nldj, nlej 812 DO ji = nldi, nlei 813 zemp_tlin(ji,jj) = znssh(ji,jj) 814 END DO 815 END DO 816 817 ENDIF 818 IF ( (jpert == 6) .OR. (jpert == jpertmax) ) THEN 787 819 788 CALL grid_random( znssh, 'T', 0.0_wp, stdssh ) 820 789 DO jj = nldj, nlej … … 834 803 ub_tl(:,:,:) = zub_tlin(:,:,:) 835 804 vb_tl(:,:,:) = zvb_tlin(:,:,:) 836 emp_tl (:,:) = zemp_tlin (:,:)837 805 sshn_tl(:,:) = zsshn_tlin(:,:) 838 806 839 gcx_tl (:,:) = 0.e0 ; gcxb_tl(:,:) = 0.e0840 807 gcb_tl (:,:) = 0.e0 841 808 gcx_tl (:,:) = zgcx_tlin (:,:) ; gcxb_tl(:,:) = zgcxb_tlin(:,:) 842 809 810 CALL sol_mat( istp ) ! for nitend, it is not called in _tan so it is still set to the nit000 case 843 811 CALL dyn_spg_flt_tan( istp, indic ) 844 812 845 813 zua_tlout(:,:,:) = ua_tl(:,:,:) ; zva_tlout(:,:,:) = va_tl(:,:,:) 846 zspgu_tlout(:,:) = spgu_tl(:,:) ; zspgv_tlout(:,:) = spgv_tl(:,:) 847 zgcb_tlout (:,:) = gcb_tl (:,:) 814 zgcxb_tlout(:,:) = gcxb_tl(:,:) ; zgcx_tlout (:,:) = gcx_tl (:,:) 848 815 849 816 !-------------------------------------------------------------------- … … 865 832 DO jj = nldj, nlej 866 833 DO ji = nldi, nlei 867 zgcb_adin (ji,jj) = zgcb_tlout (ji,jj) & 868 & * e1t(ji,jj) * e2t(ji,jj) * fse3u(ji,jj,1) * tmask(ji,jj,1) 869 zspgu_adin (ji,jj) = zspgu_tlout (ji,jj) & 870 & * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) * umask(ji,jj,1) 871 zspgv_adin(ji,jj) = zspgv_tlout(ji,jj) & 872 & * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) * vmask(ji,jj,1) 834 zgcx_adin (ji,jj) = zgcx_tlout (ji,jj) & 835 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) 836 zgcxb_adin(ji,jj) = zgcxb_tlout(ji,jj) & 837 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) 873 838 END DO 874 839 END DO … … 878 843 !-------------------------------------------------------------------- 879 844 880 zsp1 = DOT_PRODUCT( zua_tlout , zua_adin ) & 881 & + DOT_PRODUCT( zgcb_tlout , zgcb_adin ) & 882 & + DOT_PRODUCT( zspgu_tlout , zspgu_adin ) & 883 & + DOT_PRODUCT( zspgv_tlout , zspgv_adin ) & 884 & + DOT_PRODUCT( zva_tlout , zva_adin ) 845 zsp1 = DOT_PRODUCT( zua_tlout , zua_adin ) & 846 & + DOT_PRODUCT( zgcx_tlout , zgcx_adin ) & 847 & + DOT_PRODUCT( zgcxb_tlout , zgcxb_adin ) & 848 & + DOT_PRODUCT( zva_tlout , zva_adin ) 885 849 886 850 … … 892 856 va_ad(:,:,:) = zva_adin(:,:,:) 893 857 894 gcx_ad (:,:) = 0.0_wp ; gcxb_ad(:,:) = 0.0_wp 895 gcb_ad (:,:) = zgcb_adin (:,:) 896 spgu_ad(:,:) = zspgu_adin(:,:) 897 spgv_ad(:,:) = zspgv_adin(:,:) 898 ub_ad (:,:,:) = zub_adin (:,:,:) ; vb_ad (:,:,:) = zvb_adin (:,:,:) 858 gcx_ad (:,:) = zgcx_adin (:,:) ; gcxb_ad(:,:) = zgcxb_adin (:,:) 859 ub_ad (:,:,:) = 0.0_wp ; vb_ad (:,:,:) = 0.0_wp 899 860 900 861 CALL dyn_spg_flt_adj( istp, indic ) … … 919 880 & + DOT_PRODUCT( zgcx_tlin , zgcx_adout ) & 920 881 & + DOT_PRODUCT( zgcxb_tlin, zgcxb_adout ) & 921 & + DOT_PRODUCT( zsshn_tlin, zsshn_adout ) & 922 & + DOT_PRODUCT( zemp_tlin , zemp_adout ) 882 & + DOT_PRODUCT( zsshn_tlin, zsshn_adout ) 923 883 924 884 ! Compare the scalar products … … 936 896 cl_name = 'spg_flt Vb T1' 937 897 CASE(5) 938 cl_name = 'spg_flt emp T1'939 CASE(6)940 898 cl_name = 'spg_flt ssh T1' 941 899 CASE(jpertmax) 942 900 cl_name = 'dyn_spg_flt T1' 943 901 END SELECT 944 ELSEIF ( istp == nit 000 + 1) THEN902 ELSEIF ( istp == nitend ) THEN 945 903 SELECT CASE (jpert) 946 904 CASE(1) … … 953 911 cl_name = 'spg_flt Vb T2' 954 912 CASE(5) 955 cl_name = 'spg_flt emp T2'956 CASE(6)957 913 cl_name = 'spg_flt ssh T2' 958 914 CASE(jpertmax) … … 965 921 END DO 966 922 967 !nn_nmod = kmod ! restore initial frequency of test for the SOR solver 923 nitsor(:) = jp_it0adj ! restore nitsor to avoid non reproducible results with or without the tests 968 924 969 925 ! Deallocate memory … … 986 942 DEALLOCATE( & 987 943 & zsshn_tlin, & 988 & zemp_tlin, &989 944 & zsshn_adout,& 990 & zemp_adout, &991 945 & znssh & 992 946 & ) 993 947 DEALLOCATE( zgcx_tlin , zgcx_tlout , zgcx_adin , zgcx_adout, & 994 & zgcxb_tlin, zgcxb_tlout, zgcxb_adin, zgcxb_adout, & 995 & zgcb_tlin , zgcb_tlout , zgcb_adin , zgcb_adout & 996 & ) 997 DEALLOCATE ( zub_tlout, zvb_tlout, zub_adin , zvb_adin ) 948 & zgcxb_tlin, zgcxb_tlout, zgcxb_adin, zgcxb_adout ) 998 949 END SUBROUTINE dyn_spg_flt_adj_tst 999 950
Note: See TracChangeset
for help on using the changeset viewer.
