Changeset 2587 for branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA
- Timestamp:
- 2011-02-15T12:58:59+01:00 (13 years ago)
- Location:
- branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA
- Files:
-
- 11 edited
-
traadv_cen2_tam.F90 (modified) (9 diffs)
-
traadv_eiv_tam.F90 (modified) (1 diff)
-
traadv_tam.F90 (modified) (4 diffs)
-
traldf_lap_tam.F90 (modified) (13 diffs)
-
traldf_tam.F90 (modified) (8 diffs)
-
tranxt_tam.F90 (modified) (3 diffs)
-
traqsr_tam.F90 (modified) (1 diff)
-
trasbc_tam.F90 (modified) (10 diffs)
-
trazdf_imp_tam.F90 (modified) (11 diffs)
-
trazdf_tam.F90 (modified) (4 diffs)
-
zpshde_tam.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_cen2_tam.F90
r1885 r2587 127 127 PUBLIC tra_adv_cen2_adj ! routine called by traadv_tam.F90 128 128 PUBLIC tra_adv_cen2_adj_tst! routine called by tst.F90 129 #if defined key_tst_tlm 129 130 PUBLIC tra_adv_cen2_tlm_tst! routine called by tamtst.F90 131 #endif 130 132 131 133 REAL(wp), DIMENSION(jpi,jpj) :: & … … 935 937 936 938 END SUBROUTINE tra_adv_cen2_adj_tst 937 939 #if defined key_tst_tlm 938 940 SUBROUTINE tra_adv_cen2_tlm_tst( kumadt ) 939 941 !!----------------------------------------------------------------------- … … 968 970 USE tamtrj ! writing out state trajectory 969 971 USE par_tlm, ONLY: & 972 & tlm_bch, & 970 973 & cur_loop, & 971 974 & h_ratio … … 1027 1030 & z3r 1028 1031 CHARACTER(LEN=14) :: cl_name 1029 CHARACTER (LEN=128) :: file_out, file_wop 1032 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 1030 1033 CHARACTER (LEN=90) :: FMT 1031 1034 REAL(KIND=wp), DIMENSION(100):: & … … 1084 1087 ! Output filename Xn=F(X0) 1085 1088 !-------------------------------------------------------------------- 1086 file_wop='trj_wop_tradv_cen2'1087 1089 CALL tlm_namrd 1088 1090 gamma = h_ratio 1091 file_wop='trj_wop_tradv_cen2' 1092 file_xdx='trj_xdx_tradv_cen2' 1089 1093 !-------------------------------------------------------------------- 1090 1094 ! Initialize the tangent input with random noise: dx … … 1151 1155 ! Complete Init for Direct 1152 1156 !------------------------------------------------------------------- 1153 CALL istate_p1157 IF ( tlm_bch /= 2 ) CALL istate_p 1154 1158 1155 1159 ! *** initialize the reference trajectory … … 1184 1188 ! Compute the direct model F(X0,t=n) = Xn 1185 1189 !-------------------------------------------------------------------- 1186 CALL tra_adv_cen2(nit000, un, vn, wn) 1187 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 1190 IF ( tlm_bch /= 2 ) CALL tra_adv_cen2(nit000, un, vn, wn) 1191 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 1192 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 1188 1193 !-------------------------------------------------------------------- 1189 1194 ! Compute the Tangent 1190 1195 !-------------------------------------------------------------------- 1191 IF ( cur_loop .NE. 0) THEN 1192 !-------------------------------------------------------------------- 1193 ! Storing data 1194 !-------------------------------------------------------------------- 1195 zta_out (:,:,:) = ta (:,:,:) 1196 zsa_out (:,:,:) = sa (:,:,:) 1197 1196 IF ( tlm_bch == 2 ) THEN 1198 1197 !-------------------------------------------------------------------- 1199 1198 ! Initialize the tangent variables: dy^* = W dy … … 1214 1213 ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 1215 1214 !-------------------------------------------------------------------- 1216 1217 1215 zsp2_Ta = DOT_PRODUCT( ta_tl, ta_tl ) 1218 1216 zsp2_Sa = DOT_PRODUCT( sa_tl, sa_tl ) 1219 1217 1220 1218 zsp2 = zsp2_Ta + zsp2_Sa 1221 1222 1219 !-------------------------------------------------------------------- 1223 1220 ! Storing data 1224 1221 !-------------------------------------------------------------------- 1225 1222 CALL trj_rd_spl(file_wop) 1226 1227 1223 zta_wop (:,:,:) = ta (:,:,:) 1228 1224 zsa_wop (:,:,:) = sa (:,:,:) 1229 1225 CALL trj_rd_spl(file_xdx) 1226 zta_out (:,:,:) = ta (:,:,:) 1227 zsa_out (:,:,:) = sa (:,:,:) 1230 1228 !-------------------------------------------------------------------- 1231 1229 ! Compute the Linearization Error … … 1372 1370 END SUBROUTINE tra_adv_cen2_tlm_tst 1373 1371 #endif 1374 1372 #endif 1375 1373 !!====================================================================== 1376 1374 END MODULE traadv_cen2_tam -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_eiv_tam.F90
r1885 r2587 23 23 & wp 24 24 USE par_oce , ONLY: & ! Ocean space and time domain variables 25 & jpi, &26 & jpj, &27 & jpk25 & jpi, jpj, jpk 26 USE in_out_manager, ONLY: & ! I/O manager 27 & lwp, numout 28 28 29 29 IMPLICIT NONE -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traadv_tam.F90
r1885 r2587 43 43 & tra_adv_cen2_tan, & 44 44 & tra_adv_cen2_adj, & 45 & tra_adv_cen2_adj_tst, & 46 & tra_adv_cen2_tlm_tst 45 #if defined key_tst_tlm 46 & tra_adv_cen2_tlm_tst, & 47 #endif 48 & tra_adv_cen2_adj_tst 47 49 USE traadv_eiv_tam, ONLY: & ! advection trend - eddy induced velocity (tra_adv_eiv routine) 48 50 & tra_adv_eiv_tan, & 49 51 & tra_adv_eiv_adj 50 ! USE in_out_manager, ONLY : & ! I/O manager51 ! & lwp, &52 ! & numout, &53 ! & nit00054 52 USE in_out_manager ! I/O manager 55 53 USE prtctl ! Print control … … 62 60 PUBLIC tra_adv_ctl_tam ! routine called by stepadj module 63 61 PUBLIC tra_adv_adj_tst ! routine called by tst module 62 #if defined key_tst_tlm 64 63 PUBLIC tra_adv_tlm_tst ! routine called by tst module 64 #endif 65 65 !!* Namelist nam_traadv 66 66 LOGICAL, PUBLIC :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag … … 305 305 ! 306 306 END SUBROUTINE tra_adv_ctl_tam 307 307 #if defined key_tst_tlm 308 308 SUBROUTINE tra_adv_tlm_tst( kumadt ) 309 309 !!----------------------------------------------------------------------- … … 335 335 END SUBROUTINE tra_adv_tlm_tst 336 336 #endif 337 #endif 337 338 338 339 -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traldf_lap_tam.F90
r1885 r2587 106 106 PUBLIC tra_ldf_lap_adj ! routine called by tradldf_tam.F90 107 107 PUBLIC tra_ldf_lap_adj_tst ! routine called by tradldf_tam.F90 108 #if defined key_tst_tlm 108 109 PUBLIC tra_ldf_lap_tlm_tst 110 #endif 109 111 110 112 !! * Substitutions … … 735 737 736 738 END SUBROUTINE tra_ldf_lap_adj_tst 737 739 #if defined key_tst_tlm 738 740 SUBROUTINE tra_ldf_lap_tlm_tst ( kumadt ) 739 741 !!----------------------------------------------------------------------- … … 775 777 & lk_c1d 776 778 USE par_tlm, ONLY: & 779 & tlm_bch, & 777 780 & cur_loop, & 778 781 & h_ratio 779 782 USE istate_mod 780 USE wzvmod ! vertical velocity783 USE zpshde 781 784 USE gridrandom, ONLY: & 782 785 & grid_rd_sd … … 785 788 & tb, sb, tn, sn, ta, & 786 789 & sa, gtu, gsu, gtv, & 787 & gsv 790 & gsv, gru, grv, rhd 788 791 USE traldf_lap ! lateral mixing (tra_ldf routine) 789 792 USE opatam_tst_ini, ONLY: & … … 877 880 & z2r ! 2D random field 878 881 CHARACTER(LEN=14) :: cl_name 879 CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out 882 CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out, file_xdx 880 883 CHARACTER (LEN=90) :: & 881 884 & FMT … … 972 975 zgtv_wop(:,:) = 0.0_wp 973 976 zgsv_wop(:,:) = 0.0_wp 974 977 IF ( tlm_bch == 2 ) THEN 975 978 tb_tl(:,:,:) = 0.0_wp 976 979 sb_tl(:,:,:) = 0.0_wp … … 981 984 gtv_tl(:,:) = 0.0_wp 982 985 gsv_tl(:,:) = 0.0_wp 983 986 ENDIF 984 987 zsctb(:) = 0.0_wp 985 988 zscta(:) = 0.0_wp … … 1002 1005 ! Output filename Xn=F(X0) 1003 1006 !-------------------------------------------------------------------- 1004 file_wop='trj_wop_tldf_lap'1005 1007 CALL tlm_namrd 1006 1008 gamma = h_ratio 1009 file_wop='trj_wop_tldf_lap' 1010 file_xdx='trj_xdx_tldf_lap' 1007 1011 !-------------------------------------------------------------------- 1008 1012 ! Initialize the tangent input with random noise: dx … … 1069 1073 ! Complete Init for Direct 1070 1074 !------------------------------------------------------------------- 1071 CALL istate_p1075 IF ( tlm_bch /= 2 ) CALL istate_p 1072 1076 1073 1077 ! *** initialize the reference trajectory … … 1076 1080 CALL trj_rea( nit000, 1 ) 1077 1081 1082 ! Compute gtu, gsu, gtv, gsv 1083 CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 1084 1078 1085 IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN 1079 1086 ztb_tlin(:,:,:) = gamma * ztb_tlin(:,:,:) … … 1101 1108 gsv(:,:) = gsv(:,:) + zgsv_tlin(:,:) 1102 1109 ENDIF 1103 IF( .NOT. lk_vvl ) CALL wzv(nit000) 1110 1104 1111 !-------------------------------------------------------------------- 1105 1112 ! Compute the direct model F(X0,t=n) = Xn 1106 1113 !-------------------------------------------------------------------- 1107 CALL tra_ldf_lap( nit000 )1108 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop)1109 1114 IF ( tlm_bch /= 2 ) CALL tra_ldf_lap( nit000 ) 1115 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 1116 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 1110 1117 !-------------------------------------------------------------------- 1111 1118 ! Compute the Tangent 1112 1119 !-------------------------------------------------------------------- 1113 IF ( cur_loop .NE. 0) THEN 1114 !-------------------------------------------------------------------- 1115 ! Storing data 1116 !-------------------------------------------------------------------- 1117 ztb_out (:,:,:) = tb (:,:,:) 1118 zsb_out (:,:,:) = sb (:,:,:) 1119 zta_out (:,:,:) = ta (:,:,:) 1120 zsa_out (:,:,:) = sa (:,:,:) 1121 zgtu_out (:,: ) = gtu (:,: ) 1122 zgsu_out (:,: ) = gsu (:,: ) 1123 zgtv_out (:,: ) = gtv (:,: ) 1124 zgsv_out (:,: ) = gsv (:,: ) 1125 1120 IF ( tlm_bch == 2 ) THEN 1126 1121 !-------------------------------------------------------------------- 1127 1122 ! Initialize the tangent variables: dy^* = W dy … … 1171 1166 zgtv_wop (:,: ) = gtv (:,: ) 1172 1167 zgsv_wop (:,: ) = gsv (:,: ) 1173 1168 CALL trj_rd_spl(file_xdx) 1169 ztb_out (:,:,:) = tb (:,:,:) 1170 zsb_out (:,:,:) = sb (:,:,:) 1171 zta_out (:,:,:) = ta (:,:,:) 1172 zsa_out (:,:,:) = sa (:,:,:) 1173 zgtu_out (:,: ) = gtu (:,: ) 1174 zgsu_out (:,: ) = gsu (:,: ) 1175 zgtv_out (:,: ) = gtv (:,: ) 1176 zgsv_out (:,: ) = gsv (:,: ) 1174 1177 !-------------------------------------------------------------------- 1175 1178 ! Compute the Linearization Error … … 1628 1631 CALL iom_close( inum ) 1629 1632 END SUBROUTINE asm_trj_wop_rd 1630 1633 #endif 1631 1634 #endif 1632 1635 !!============================================================================== -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traldf_tam.F90
r1885 r2587 11 11 !! 9.0 ! 08-06 (A. Vidard) Skeleton 12 12 !! 9.0 ! 09-03 (F. Vigilant) adding tra_ldf_lap option 13 !! 9.0 ! 10-06 (P.A. Bouttier) adding tra_ldf_bilap option 13 14 !!---------------------------------------------------------------------- 14 15 … … 25 26 & tra_ldf_lap_tan, & 26 27 & tra_ldf_lap_adj, & 27 & tra_ldf_lap_adj_tst, & 28 & tra_ldf_lap_tlm_tst 28 #if defined key_tst_tlm 29 & tra_ldf_lap_tlm_tst, & 30 #endif 31 & tra_ldf_lap_adj_tst 32 USE traldf_bilap_tam, ONLY: & !lateral mixing (tra_ldf_bilap routine) 33 & tra_ldf_bilap_tan, & 34 & tra_ldf_bilap_adj 29 35 USE in_out_manager, ONLY: & ! I/O manager 30 36 & ctl_stop, nit000, lwp, numout, nitend … … 50 56 PUBLIC tra_ldf_adj ! called by step_tam.F90 51 57 PUBLIC tra_ldf_adj_tst ! called by tamtst.F90 58 #if defined key_tst_tlm 52 59 PUBLIC tra_ldf_tlm_tst ! called by tamtst.F90 60 #endif 61 PUBLIC ldf_ctl_tam ! called by trazdf_imp (init of l_traldf_rot) 53 62 54 63 INTEGER :: nldf … … 76 85 CASE ( 0 ) ; CALL tra_ldf_lap_tan ( kt ) ! iso-level laplacian 77 86 CASE ( 1 ) ; CALL tra_ldf_iso_tan ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 87 CASE ( 2 ) ; CALL tra_ldf_bilap_tan ( kt ) ! iso-level bilaplacian 78 88 END SELECT 79 89 END SUBROUTINE tra_ldf_tan … … 94 104 CASE ( 0 ) ; CALL tra_ldf_lap_adj ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 95 105 CASE ( 1 ) ; CALL tra_ldf_iso_adj ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 106 CASE ( 2 ) ; CALL tra_ldf_bilap_adj ( kt ) ! iso-level bilaplacian 96 107 END SELECT 97 108 ! … … 206 217 207 218 IF( ln_traldf_bilap ) THEN ! bilaplacian operator 208 CALL ctl_stop( ' You shouldn t have seen this error message, ln_trad_bilap option not impemented yet for tam' ) 219 IF ( ln_zco ) THEN ! z-coordinate 220 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 221 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 222 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 223 ENDIF 224 IF ( ln_zps ) THEN ! z-coordinate 225 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 226 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 227 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 228 ENDIF 209 229 ENDIF 210 230 211 231 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 232 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 212 233 IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 213 234 CALL ctl_stop( ' eddy induced velocity on tracers', & … … 227 248 END SUBROUTINE ldf_ctl_tam 228 249 229 250 #if defined key_tst_tlm 230 251 SUBROUTINE tra_ldf_tlm_tst( kumadt ) 231 252 !!----------------------------------------------------------------------- … … 266 287 !!====================================================================== 267 288 #endif 289 #endif 268 290 END MODULE traldf_tam -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/tranxt_tam.F90
r1885 r2587 229 229 ! 230 230 END SUBROUTINE tra_nxt_tan 231 232 231 SUBROUTINE tra_nxt_adj( kt ) 233 232 !!---------------------------------------------------------------------- … … 476 475 ! Reset the tangent and adjoint variables 477 476 !-------------------------------------------------------------------- 478 zsa_tlin(:,:,:) = 0.0_wp479 zta_tlin(:,:,:) = 0.0_wp480 zsb_tlin(:,:,:) = 0.0_wp481 ztb_tlin(:,:,:) = 0.0_wp482 zsn_tlin(:,:,:) = 0.0_wp483 ztn_tlin(:,:,:) = 0.0_wp484 zsa_adin(:,:,:) = 0.0_wp485 zta_adin(:,:,:) = 0.0_wp486 zsb_adin(:,:,:) = 0.0_wp487 ztb_adin(:,:,:) = 0.0_wp488 zsn_adin(:,:,:) = 0.0_wp489 ztn_adin(:,:,:) = 0.0_wp490 477 sb_tl(:,:,:) = 0.0_wp 491 478 tb_tl(:,:,:) = 0.0_wp … … 500 487 sn_ad(:,:,:) = 0.0_wp 501 488 tn_ad(:,:,:) = 0.0_wp 489 zsb_tlin(:,:,:) = 0.0_wp 490 ztb_tlin(:,:,:) = 0.0_wp 491 zsa_tlin(:,:,:) = 0.0_wp 492 zta_tlin(:,:,:) = 0.0_wp 493 zsn_tlin(:,:,:) = 0.0_wp 494 ztn_tlin(:,:,:) = 0.0_wp 502 495 503 496 DO jj = 1, jpj -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/traqsr_tam.F90
r1947 r2587 277 277 DO ji = fs_2, fs_jpim1 ! vector opt. 278 278 ! qsr trend 279 qsr_ad(ji,jj) = qsr_ad(ji,jj) + ta_ad(ji,jj,jk) * zc0 & 280 & * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 279 qsr_ad(ji,jj) = qsr_ad(ji,jj) + ta_ad(ji,jj,jk) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) ) 281 280 END DO 282 281 END DO -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trasbc_tam.F90
r1885 r2587 96 96 PUBLIC tra_sbc_adj ! routine called by step_tam.F90 97 97 PUBLIC tra_sbc_adj_tst ! routine called by tst.F90 98 #if defined key_tst_tlm 98 99 PUBLIC tra_sbc_tlm_tst ! routine calle by tamtst.F90 100 #endif 99 101 100 102 !! * Substitutions … … 579 581 END SUBROUTINE tra_sbc_adj_tst 580 582 581 583 #if defined key_tst_tlm 582 584 SUBROUTINE tra_sbc_tlm_tst ( kumadt ) 583 585 !!----------------------------------------------------------------------- … … 612 614 USE tamtrj ! writing out state trajectory 613 615 USE par_tlm, ONLY: & 616 & tlm_bch, & 614 617 & cur_loop, & 615 618 & h_ratio … … 676 679 & zgsp7 677 680 CHARACTER (LEN=14) :: cl_name 678 CHARACTER (LEN=128) :: file_out, file_wop 681 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 679 682 CHARACTER (LEN=90) :: FMT 680 683 REAL(KIND=wp), DIMENSION(100):: & … … 731 734 ! Output filename Xn=F(X0) 732 735 !-------------------------------------------------------------------- 733 file_wop='trj_wop_trasbc'734 736 CALL tlm_namrd 735 737 gamma = h_ratio 738 file_wop='trj_wop_trasbc' 739 file_xdx='trj_xdx_trasbc' 736 740 !-------------------------------------------------------------------- 737 741 ! Initialize the tangent input with random noise: dx … … 778 782 ! Complete Init for Direct 779 783 !------------------------------------------------------------------- 780 CALL istate_p784 IF ( tlm_bch /= 2 ) CALL istate_p 781 785 782 786 ! *** initialize the reference trajectory … … 804 808 ! Compute the direct model F(X0,t=n) = Xn 805 809 !-------------------------------------------------------------------- 806 CALL tra_sbc(nit000) 807 808 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 809 810 IF ( tlm_bch /= 2 ) CALL tra_sbc(nit000) 811 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 812 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 810 813 !-------------------------------------------------------------------- 811 814 ! Compute the Tangent 812 815 !-------------------------------------------------------------------- 813 IF ( cur_loop .NE. 0) THEN 814 !-------------------------------------------------------------------- 815 ! Storing data 816 !-------------------------------------------------------------------- 817 zta_out (:,:,:) = ta (:,:,:) 818 zsa_out (:,:,:) = sa (:,:,:) 819 816 IF ( tlm_bch == 2 ) THEN 820 817 !-------------------------------------------------------------------- 821 818 ! Initialize the tangent variables: dy^* = W dy … … 836 833 ! Compute the scalar product: ( L(t0,tn) gamma dx0 ) ) 837 834 !-------------------------------------------------------------------- 838 839 835 zsp2_1 = DOT_PRODUCT( ta_tl, ta_tl ) 840 836 zsp2_2 = DOT_PRODUCT( sa_tl, sa_tl ) … … 847 843 zta_wop (:,:,:) = ta (:,:,:) 848 844 zsa_wop (:,:,:) = sa (:,:,:) 845 CALL trj_rd_spl(file_xdx) 846 zta_out (:,:,:) = ta (:,:,:) 847 zsa_out (:,:,:) = sa (:,:,:) 849 848 !-------------------------------------------------------------------- 850 849 ! Compute the Linearization Error … … 981 980 !!====================================================================== 982 981 #endif 982 #endif 983 983 END MODULE trasbc_tam -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trazdf_imp_tam.F90
r1885 r2587 74 74 & ahtw, & 75 75 & aht0 76 #if defined key_ldfslp 76 77 USE ldfslp , ONLY: & ! lateral physics: slope of diffusion 77 78 & wslpi, & !: i_slope at W-points 78 79 & wslpj !: j-slope at W-points 80 #endif 79 81 #if defined key_zdfddm 80 82 USE zdfddm , ONLY: & 81 83 & avs 82 84 #endif 85 USE traldf_tam 83 86 USE in_out_manager, ONLY: & ! I/O manager 84 87 & lwp, & … … 106 109 PUBLIC tra_zdf_imp_adj ! routine called by tra_zdf_adj.F90 107 110 PUBLIC tra_zdf_imp_adj_tst ! routine called by tst.F90 111 #if defined key_tst_tlm 108 112 PUBLIC tra_zdf_imp_tlm_tst ! routine called by tamtst.F90 113 #endif 109 114 110 115 !! * Substitutions … … 483 488 !!--------------------------------------------------------------------- 484 489 485 IF( kt == nit 000) THEN490 IF( kt == nitend ) THEN 486 491 IF(lwp)WRITE(numout,*) 487 492 IF(lwp)WRITE(numout,*) 'tra_zdf_imp_adj : implicit vertical mixing' 488 493 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~~~~ ' 494 CALL ldf_ctl_tam ! init of l_traldf_rot 489 495 zavi = 0._wp ! avoid warning at compilation phase when lk_ldfslp=F 490 496 ENDIF … … 985 991 986 992 END SUBROUTINE tra_zdf_imp_adj_tst 987 993 #if defined key_tst_tlm 988 994 SUBROUTINE tra_zdf_imp_tlm_tst( kumadt ) 989 995 !!----------------------------------------------------------------------- … … 1019 1025 USE tamtrj ! writing out state trajectory 1020 1026 USE par_tlm, ONLY: & 1027 & tlm_bch, & 1021 1028 & cur_loop, & 1022 1029 & h_ratio … … 1077 1084 CHARACTER(LEN=14) ::& 1078 1085 & cl_name 1079 CHARACTER (LEN=128) :: file_out, file_wop 1086 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 1080 1087 CHARACTER (LEN=90) :: & 1081 1088 & FMT … … 1126 1133 ! Output filename Xn=F(X0) 1127 1134 !-------------------------------------------------------------------- 1128 file_wop='trj_wop_trazdf_imp'1129 1135 CALL tlm_namrd 1130 1136 gamma = h_ratio 1137 file_wop='trj_wop_trazdf_imp' 1138 file_xdx='trj_xdx_trazdf_imp' 1131 1139 !-------------------------------------------------------------------- 1132 1140 ! Initialize the tangent input with random noise: dx … … 1169 1177 ! Complete Init for Direct 1170 1178 !------------------------------------------------------------------- 1171 CALL istate_p1179 IF ( tlm_bch /= 2 ) CALL istate_p 1172 1180 1173 1181 ! *** initialize the reference trajectory … … 1192 1200 ! Compute the direct model F(X0,t=n) = Xn 1193 1201 !-------------------------------------------------------------------- 1194 CALL tra_zdf_imp(nit000, rdttra) 1195 1196 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 1197 1202 IF ( tlm_bch /= 2 ) CALL tra_zdf_imp(nit000, rdttra) 1203 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 1204 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 1198 1205 !-------------------------------------------------------------------- 1199 1206 ! Compute the Tangent 1200 1207 !-------------------------------------------------------------------- 1201 IF ( cur_loop .NE. 0) THEN 1202 !-------------------------------------------------------------------- 1203 ! Storing data 1204 !-------------------------------------------------------------------- 1205 zta_out (:,:,:) = ta (:,:,:) 1206 zsa_out (:,:,:) = sa (:,:,:) 1208 IF ( tlm_bch == 2 ) THEN 1207 1209 !-------------------------------------------------------------------- 1208 1210 ! Initialize the tangent variables: dy^* = W dy … … 1235 1237 zta_wop (:,:,:) = ta (:,:,:) 1236 1238 zsa_wop (:,:,:) = sa (:,:,:) 1237 1239 CALL trj_rd_spl(file_xdx) 1240 zta_out (:,:,:) = ta (:,:,:) 1241 zsa_out (:,:,:) = sa (:,:,:) 1238 1242 !-------------------------------------------------------------------- 1239 1243 ! Compute the Linearization Error … … 1378 1382 END SUBROUTINE tra_zdf_imp_tlm_tst 1379 1383 #endif 1384 #endif 1380 1385 END MODULE trazdf_imp_tam -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/trazdf_tam.F90
r1885 r2587 46 46 & tra_zdf_imp_tan, & 47 47 & tra_zdf_imp_adj, & 48 & tra_zdf_imp_adj_tst, & 49 & tra_zdf_imp_tlm_tst 48 #if defined key_tst_tlm 49 & tra_zdf_imp_tlm_tst, & 50 #endif 51 & tra_zdf_imp_adj_tst 50 52 USE in_out_manager, ONLY: & ! I/O manager 51 53 & lwp, & … … 63 65 & tra_zdf_tan, & 64 66 & tra_zdf_adj ! routines called by step_tam.F90 65 PUBLIC & 66 & tra_zdf_adj_tst, & ! routine called by tst.F90 67 & tra_zdf_tlm_tst ! routine called by tst.F90 67 PUBLIC tra_zdf_adj_tst ! routine called by tst.F90 68 #if defined key_tst_tlm 69 PUBLIC tra_zdf_tlm_tst ! routine called by tst.F90 70 #endif 68 71 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 69 72 ! ! defined from ln_zdf... namlist logicals) … … 247 250 248 251 END SUBROUTINE zdf_ctl_tam 249 252 #if defined key_tst_tlm 250 253 SUBROUTINE tra_zdf_tlm_tst( kumadt ) 251 254 !!----------------------------------------------------------------------- … … 282 285 END SUBROUTINE tra_zdf_tlm_tst 283 286 #endif 287 #endif 284 288 END MODULE trazdf_tam -
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TRA/zpshde_tam.F90
r1885 r2587 78 78 PUBLIC zps_hde_adj ! routine called by step_tam.F90 79 79 PUBLIC zps_hde_adj_tst ! routine called by tst.F90 80 #if defined key_tst_tlm 80 81 PUBLIC zps_hde_tlm_tst ! routine called by tamtst.F90 82 #endif 81 83 82 84 !! * module variables … … 946 948 947 949 END SUBROUTINE zps_hde_adj_tst 948 950 #if defined key_tst_tlm 949 951 SUBROUTINE zps_hde_tlm_tst( kumadt ) 950 952 !!----------------------------------------------------------------------- … … 984 986 USE tamtrj ! writing out state trajectory 985 987 USE par_tlm, ONLY: & 988 & tlm_bch, & 986 989 & cur_loop, & 987 990 & h_ratio … … 1049 1052 & zgsp7 1050 1053 CHARACTER(LEN=14) :: cl_name 1051 CHARACTER (LEN=128) :: file_out, file_wop 1054 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 1052 1055 CHARACTER (LEN=90) :: FMT 1053 1056 REAL(KIND=wp), DIMENSION(100):: & … … 1104 1107 zgru_out(:,:) = 0.0_wp 1105 1108 zgrv_out(:,:) = 0.0_wp 1109 IF ( tlm_bch == 2 ) THEN 1106 1110 gtu_tl(:,:) = 0.0_wp 1107 1111 gtv_tl(:,:) = 0.0_wp … … 1110 1114 gru_tl(:,:) = 0.0_wp 1111 1115 grv_tl(:,:) = 0.0_wp 1112 1116 ENDIF 1113 1117 zscgtu(:) = 0.0_wp 1114 1118 zscgtv(:) = 0.0_wp … … 1132 1136 ! Output filename Xn=F(X0) 1133 1137 !-------------------------------------------------------------------- 1134 file_wop='trj_wop_zps'1135 1138 CALL tlm_namrd 1136 1139 gamma = h_ratio 1140 file_wop='trj_wop_zps' 1141 file_xdx='trj_xdx_zps' 1137 1142 !-------------------------------------------------------------------- 1138 1143 ! Initialize the tangent input with random noise: dx … … 1167 1172 ! Complete Init for Direct 1168 1173 !------------------------------------------------------------------- 1169 CALL istate_p 1170 1174 IF ( tlm_bch /= 2 ) CALL istate_p 1171 1175 ! *** initialize the reference trajectory 1172 1176 ! ------------ … … 1187 1191 ! Compute the direct model F(X0,t=n) = Xn 1188 1192 !-------------------------------------------------------------------- 1189 CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 1190 1191 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 1192 1193 IF ( tlm_bch /= 2 ) CALL zps_hde(nit000, tn, sn, rhd, gtu, gsu, gru, gtv, gsv, grv) 1194 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 1195 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 1193 1196 !-------------------------------------------------------------------- 1194 1197 ! Compute the Tangent 1195 1198 !-------------------------------------------------------------------- 1196 IF ( cur_loop .NE. 0) THEN 1197 !-------------------------------------------------------------------- 1198 ! Storing data 1199 !-------------------------------------------------------------------- 1200 zgtu_out (:,:) = gtu (:,:) 1201 zgtv_out (:,:) = gtv (:,:) 1202 zgsu_out (:,:) = gsu (:,:) 1203 zgsv_out (:,:) = gsv (:,:) 1204 zgru_out (:,:) = gru (:,:) 1205 zgrv_out (:,:) = grv (:,:) 1206 1199 IF ( tlm_bch == 2 ) THEN 1207 1200 !-------------------------------------------------------------------- 1208 1201 ! Initialize the tangent variables: … … 1241 1234 zgru_wop (:,:) = gru (:,:) 1242 1235 zgrv_wop (:,:) = grv (:,:) 1236 CALL trj_rd_spl(file_xdx) 1237 zgtu_out (:,:) = gtu (:,:) 1238 zgtv_out (:,:) = gtv (:,:) 1239 zgsu_out (:,:) = gsu (:,:) 1240 zgsv_out (:,:) = gsv (:,:) 1241 zgru_out (:,:) = gru (:,:) 1242 zgrv_out (:,:) = grv (:,:) 1243 1243 !-------------------------------------------------------------------- 1244 1244 ! Compute the Linearization Error … … 1471 1471 !!====================================================================== 1472 1472 #endif 1473 #endif 1473 1474 END MODULE zpshde_tam
Note: See TracChangeset
for help on using the changeset viewer.
