Changeset 2587 for branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/eosbn2_tam.F90
- Timestamp:
- 2011-02-15T12:58:59+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/eosbn2_tam.F90
r1885 r2587 130 130 PUBLIC eos_adj_tst 131 131 PUBLIC bn2_adj_tst 132 #if defined key_tst_tlm 132 133 PUBLIC eos_tlm_tst 133 134 PUBLIC bn2_tlm_tst 135 #endif 134 136 #endif 135 137 … … 3057 3059 3058 3060 END SUBROUTINE bn2_adj_tst 3059 3061 #if defined key_tst_tlm 3060 3062 SUBROUTINE eos_insitu_tlm_tst( kumadt ) 3061 3063 !!----------------------------------------------------------------------- … … 3091 3093 USE tamtrj ! writing out state trajectory 3092 3094 USE par_tlm, ONLY: & 3095 & tlm_bch, & 3093 3096 & cur_loop, & 3094 3097 & h_ratio … … 3134 3137 & jk 3135 3138 CHARACTER(LEN=14) :: cl_name 3136 CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out 3139 CHARACTER (LEN=128) :: file_out_sc, file_wop, file_out, file_xdx 3137 3140 CHARACTER (LEN=90) :: FMT 3138 3141 REAL(KIND=wp), DIMENSION(100):: & … … 3160 3163 zs_tlin( :,:,:) = 0.0_wp 3161 3164 zrd_out( :,:,:) = 0.0_wp 3162 zrd_tl ( :,:,:) = 0.0_wp3163 3165 zrd_wop( :,:,:) = 0.0_wp 3164 3166 zscerrrd(:) = 0.0_wp 3165 3167 zscrd(:) = 0.0_wp 3166 3168 IF ( tlm_bch == 2 ) zrd_tl ( :,:,:) = 0.0_wp 3167 3169 !-------------------------------------------------------------------- 3168 3170 ! Output filename Xn=F(X0) 3169 3171 !-------------------------------------------------------------------- 3170 file_wop='trj_wop_eos_insitu'3171 3172 CALL tlm_namrd 3172 3173 gamma = h_ratio 3174 file_wop='trj_wop_eos_insitu' 3175 file_xdx='trj_xdx_eos_insitu' 3173 3176 !-------------------------------------------------------------------- 3174 3177 ! Initialize the tangent input with random noise: dx … … 3196 3199 ! Complete Init for Direct 3197 3200 !------------------------------------------------------------------- 3198 CALL istate_p3201 IF ( tlm_bch /= 2 ) CALL istate_p 3199 3202 3200 3203 ! *** initialize the reference trajectory … … 3213 3216 ! Compute the direct model F(X0,t=n) = Xn 3214 3217 !-------------------------------------------------------------------- 3215 CALL eos(tn, sn, zrd_out)3218 IF ( tlm_bch /= 2 ) CALL eos(tn, sn, zrd_out) 3216 3219 rhd(:,:,:)= zrd_out(:,:,:) 3217 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 3220 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 3221 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 3218 3222 !-------------------------------------------------------------------- 3219 3223 ! Compute the Tangent 3220 3224 !-------------------------------------------------------------------- 3221 IF ( cur_loop .NE. 0) THEN 3222 !-------------------------------------------------------------------- 3223 ! Storing data 3224 !-------------------------------------------------------------------- 3225 IF ( tlm_bch == 2 ) THEN 3225 3226 !-------------------------------------------------------------------- 3226 3227 ! Initialize the tangent variables: dy^* = W dy … … 3241 3242 CALL trj_rd_spl(file_wop) 3242 3243 zrd_wop (:,:,:) = rhd (:,:,:) 3243 3244 CALL trj_rd_spl(file_xdx) 3245 zrd_out (:,:,:) = rhd (:,:,:) 3244 3246 !-------------------------------------------------------------------- 3245 3247 ! Compute the Linearization Error … … 3367 3369 USE tamtrj ! writing out state trajectory 3368 3370 USE par_tlm, ONLY: & 3371 & tlm_bch, & 3369 3372 & cur_loop, & 3370 3373 & h_ratio … … 3416 3419 & jk 3417 3420 CHARACTER(LEN=14) :: cl_name 3418 CHARACTER (LEN=128) :: file_out, file_wop 3421 CHARACTER (LEN=128) :: file_out, file_wop,file_xdx 3419 3422 CHARACTER (LEN=90) :: FMT 3420 3423 REAL(KIND=wp), DIMENSION(100):: & … … 3447 3450 zrd_out( :,:,:) = 0.0_wp 3448 3451 zrh_out( :,:,:) = 0.0_wp 3449 zrd_tl ( :,:,:) = 0.0_wp3450 zrh_tl ( :,:,:) = 0.0_wp3451 3452 zrd_wop( :,:,:) = 0.0_wp 3452 3453 zrh_wop( :,:,:) = 0.0_wp … … 3455 3456 zscrd(:) = 0.0_wp 3456 3457 zscrh(:) = 0.0_wp 3457 3458 IF ( tlm_bch == 2 ) THEN 3459 zrd_tl ( :,:,:) = 0.0_wp 3460 zrh_tl ( :,:,:) = 0.0_wp 3461 ENDIF 3458 3462 !-------------------------------------------------------------------- 3459 3463 ! Output filename Xn=F(X0) 3460 3464 !-------------------------------------------------------------------- 3461 file_wop='trj_wop_eos_pot'3462 3465 CALL tlm_namrd 3463 3466 gamma = h_ratio 3467 file_wop='trj_wop_eos_pot' 3468 file_xdx='trj_xdx_eos_pot' 3464 3469 !-------------------------------------------------------------------- 3465 3470 ! Initialize the tangent input with random noise: dx … … 3486 3491 ! Complete Init for Direct 3487 3492 !------------------------------------------------------------------- 3488 CALL istate_p3493 IF ( tlm_bch /= 2 ) CALL istate_p 3489 3494 3490 3495 ! *** initialize the reference trajectory … … 3503 3508 ! Compute the direct model F(X0,t=n) = Xn 3504 3509 !-------------------------------------------------------------------- 3505 CALL eos(tn, sn, zrd_out, zrh_out)3510 IF ( tlm_bch /= 2 ) CALL eos(tn, sn, zrd_out, zrh_out) 3506 3511 rhd (:,:,:) = zrd_out(:,:,:) 3507 3512 rhop(:,:,:) = zrh_out(:,:,:) 3508 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 3513 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 3514 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 3509 3515 !-------------------------------------------------------------------- 3510 3516 ! Compute the Tangent 3511 3517 !-------------------------------------------------------------------- 3512 IF ( cur_loop .NE. 0) THEN 3513 !-------------------------------------------------------------------- 3514 ! Storing data 3515 !-------------------------------------------------------------------- 3518 IF ( tlm_bch == 2 ) THEN 3516 3519 !-------------------------------------------------------------------- 3517 3520 ! Initialize the tangent variables: dy^* = W dy … … 3536 3539 zrd_wop (:,:,:) = rhd (:,:,:) 3537 3540 zrh_wop (:,:,:) = rhop (:,:,:) 3538 3541 CALL trj_rd_spl(file_xdx) 3542 zrd_out (:,:,:) = rhd (:,:,:) 3543 zrh_out (:,:,:) = rhop (:,:,:) 3539 3544 !-------------------------------------------------------------------- 3540 3545 ! Compute the Linearization Error … … 3695 3700 USE tamtrj ! writing out state trajectory 3696 3701 USE par_tlm, ONLY: & 3702 & tlm_bch, & 3697 3703 & cur_loop, & 3698 3704 & h_ratio … … 3741 3747 & jj 3742 3748 CHARACTER(LEN=14) :: cl_name 3743 CHARACTER (LEN=128) :: file_out, file_wop 3749 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 3744 3750 CHARACTER (LEN=90) :: FMT 3745 3751 REAL(KIND=wp), DIMENSION(100):: & … … 3771 3777 zs_tlin( :,:) = 0.0_wp 3772 3778 zrd_out( :,:) = 0.0_wp 3773 zrd_tl ( :,:) = 0.0_wp3774 3779 zrd_wop( :,:) = 0.0_wp 3775 3780 zscerrrd( :) = 0.0_wp 3776 3781 zscrd(:) = 0.0_wp 3777 3782 IF ( tlm_bch == 2 ) zrd_tl ( :,:) = 0.0_wp 3778 3783 !-------------------------------------------------------------------- 3779 3784 ! Output filename Xn=F(X0) 3780 3785 !-------------------------------------------------------------------- 3781 file_wop='trj_wop_eos_2d'3782 3783 3786 CALL tlm_namrd 3784 3787 gamma = h_ratio 3788 file_wop='trj_wop_eos_2d' 3789 file_xdx='trj_xdx_eos_2d' 3785 3790 !-------------------------------------------------------------------- 3786 3791 ! Initialize the tangent input with random noise: dx … … 3804 3809 ! Complete Init for Direct 3805 3810 !------------------------------------------------------------------- 3806 CALL istate_p3811 IF ( tlm_bch /= 2 ) CALL istate_p 3807 3812 ! *** initialize the reference trajectory 3808 3813 ! ------------ … … 3824 3829 ! Compute the direct model F(X0,t=n) = Xn 3825 3830 !-------------------------------------------------------------------- 3826 CALL eos(ztem, zsal, zdep, zrd_out)3831 IF ( tlm_bch /= 2 ) CALL eos(ztem, zsal, zdep, zrd_out) 3827 3832 rhd (:,:,2) = zrd_out(:,:) 3828 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 3833 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 3834 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 3829 3835 !-------------------------------------------------------------------- 3830 3836 ! Compute the Tangent 3831 3837 !-------------------------------------------------------------------- 3832 IF ( cur_loop .NE. 0) THEN 3833 !-------------------------------------------------------------------- 3834 ! Storing data 3835 !-------------------------------------------------------------------- 3838 IF ( tlm_bch == 2 ) THEN 3836 3839 !-------------------------------------------------------------------- 3837 3840 ! Initialize the tangent variables: dy^* = W dy … … 3854 3857 CALL trj_rd_spl(file_wop) 3855 3858 zrd_wop (:,:) = rhd (:,:,2) 3859 CALL trj_rd_spl(file_xdx) 3860 zrd_out (:,:) = rhd (:,:,2) 3856 3861 !-------------------------------------------------------------------- 3857 3862 ! Compute the Linearization Error … … 3976 3981 USE tamtrj ! writing out state trajectory 3977 3982 USE par_tlm, ONLY: & 3983 & tlm_bch, & 3978 3984 & cur_loop, & 3979 3985 & h_ratio … … 4023 4029 & z3r 4024 4030 CHARACTER(LEN=14) :: cl_name 4025 CHARACTER (LEN=128) :: file_out, file_wop 4031 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 4026 4032 CHARACTER (LEN=90) :: FMT 4027 4033 REAL(KIND=wp), DIMENSION(100):: & … … 4051 4057 ! Output filename Xn=F(X0) 4052 4058 !-------------------------------------------------------------------- 4053 file_wop='trj_wop_bn2'4054 4055 4059 CALL tlm_namrd 4056 4060 gamma = h_ratio 4061 file_wop='trj_wop_bn2' 4062 file_xdx='trj_xdx_bn2' 4057 4063 !-------------------------------------------------------------------- 4058 4064 ! Initialize the tangent input with random noise: dx … … 4079 4085 ! Complete Init for Direct 4080 4086 !------------------------------------------------------------------- 4081 CALL istate_p4087 IF ( tlm_bch /= 2 ) CALL istate_p 4082 4088 4083 4089 ! *** initialize the reference trajectory … … 4098 4104 ! Compute the direct model F(X0,t=n) = Xn 4099 4105 !-------------------------------------------------------------------- 4100 CALL bn2(tn, sn, rn2) 4101 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 4106 IF ( tlm_bch /= 2 ) CALL bn2(tn, sn, rn2) 4107 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 4108 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 4102 4109 !-------------------------------------------------------------------- 4103 4110 ! Compute the Tangent 4104 4111 !-------------------------------------------------------------------- 4105 IF ( cur_loop .NE. 0) THEN 4106 !-------------------------------------------------------------------- 4107 ! Storing data 4108 !-------------------------------------------------------------------- 4109 zrn2_out (:,:,:) = rn2 (:,:,:) 4110 4112 IF ( tlm_bch == 2 ) THEN 4111 4113 !-------------------------------------------------------------------- 4112 4114 ! Initialize the tangent variables: dy^* = W dy … … 4131 4133 CALL trj_rd_spl(file_wop) 4132 4134 zrn2_wop (:,:,:) = rn2 (:,:,:) 4133 4135 CALL trj_rd_spl(file_xdx) 4136 zrn2_out (:,:,:) = rn2 (:,:,:) 4134 4137 !-------------------------------------------------------------------- 4135 4138 ! Compute the Linearization Error … … 4244 4247 END SUBROUTINE eos_tlm_tst 4245 4248 #endif 4249 #endif 4246 4250 !!====================================================================== 4247 4251 END MODULE eosbn2_tam
Note: See TracChangeset
for help on using the changeset viewer.
