- 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/DYN/dynspg_flt_tam.F90
r1885 r2587 178 178 & stdemp, & 179 179 & stdssh, & 180 & stdgc, & 180 181 & prntst_adj, & 181 182 & prntst_tlm … … 187 188 PUBLIC dyn_spg_flt_tan, & ! routine called by step_tan.F90 188 189 & dyn_spg_flt_adj, & ! routine called by step_adj.F90 189 & dyn_spg_flt_adj_tst, & ! routine called by the tst.F90 190 & dyn_spg_flt_tlm_tst 191 190 & dyn_spg_flt_adj_tst ! routine called by the tst.F90 191 #if defined key_tst_tlm 192 PUBLIC dyn_spg_flt_tlm_tst 193 #endif 192 194 !! * Substitutions 193 195 # include "domzgr_substitute.h90" … … 1395 1397 END SUBROUTINE dyn_spg_flt_adj_tst 1396 1398 1397 1399 #if defined key_tst_tlm 1398 1400 SUBROUTINE dyn_spg_flt_tlm_tst( kumadt ) 1399 1401 !!----------------------------------------------------------------------- … … 1430 1432 USE tamtrj ! writing out state trajectory 1431 1433 USE par_tlm, ONLY: & 1434 & tlm_bch, & 1432 1435 & cur_loop, & 1433 1436 & h_ratio … … 1438 1441 USE oce , ONLY: & ! ocean dynamics and tracers variables 1439 1442 & ua, va, ub, vb, & 1443 & un, vn, & 1440 1444 & sshb, sshn, wn 1441 1445 USE sbc_oce , ONLY: & 1442 1446 & emp 1447 USE sol_oce , ONLY: & ! ocean dynamics and tracers variables 1448 & gcb, gcx 1443 1449 USE tamctl, ONLY: & ! Control parameters 1444 1450 & numtan, numtan_sc … … 1469 1475 & zsshn_wop, & 1470 1476 & z2r ! 2D field 1477 REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: & 1478 & zgcb_tlin , & ! Tangent input 1479 & zgcx_tlin , & ! Tangent input 1480 & zgcb_out , & ! Direct output 1481 & zgcx_out , & ! Direct output 1482 & zgcb_wop , & ! Direct output without perturbation 1483 & zgcx_wop , & ! Direct output without perturbation 1484 & zr ! 3D random field 1471 1485 REAL(KIND=wp) :: & 1472 1486 & zsp1, zsp1_1, zsp1_2, zsp1_3, zsp1_4, & ! … … 1475 1489 & zzsp, zzsp_1, zzsp_2, zzsp_3, zzsp_4, & 1476 1490 & gamma, & 1491 & zsp_5,zsp1_5, zsp2_5, zsp3_5, zsp4_5, & 1492 & zzsp_5, zsp_6, & 1477 1493 & zgsp1, zgsp2, zgsp3, zgsp4, zgsp5, & 1478 1494 & zgsp6, zgsp7 … … 1485 1501 & jk 1486 1502 CHARACTER(LEN=14) :: cl_name 1487 CHARACTER (LEN=128) :: file_out, file_wop 1503 CHARACTER (LEN=128) :: file_out, file_wop, file_xdx 1488 1504 CHARACTER (LEN=90) :: FMT 1489 1505 REAL(KIND=wp), DIMENSION(100):: & … … 1492 1508 & zscsshb, zscsshn, & 1493 1509 & zscerrsshb, zscerrsshn 1510 REAL(KIND=wp), DIMENSION(jpi,jpj) :: & 1511 & zerrgcb, zerrgcx 1512 REAL(KIND=wp), DIMENSION(100):: & 1513 & zscgcb,zscgcx, & 1514 & zscerrgcb, zscerrgcx 1515 INTEGER, DIMENSION(100):: & 1516 & iiposgcb, ijposgcb, & 1517 & iiposgcx, ijposgcx 1494 1518 INTEGER, DIMENSION(100):: & 1495 1519 & iipossshb, iipossshn, iiposua, iiposva, & … … 1530 1554 & z2r(jpi,jpj) & 1531 1555 & ) 1556 ALLOCATE( & 1557 & zgcb_tlin( jpi,jpj), & 1558 & zgcx_tlin( jpi,jpj), & 1559 & zgcb_out ( jpi,jpj), & 1560 & zgcx_out ( jpi,jpj), & 1561 & zgcb_wop ( jpi,jpj), & 1562 & zgcx_wop ( jpi,jpj), & 1563 & zr( jpi,jpj) & 1564 & ) 1532 1565 !-------------------------------------------------------------------- 1533 1566 ! Reset variables … … 1562 1595 zerrsshb(:,:) = 0.0_wp 1563 1596 zerrsshn(:,:) = 0.0_wp 1597 1598 zgcb_tlin( :,:) = 0.0_wp 1599 zgcx_tlin( :,:) = 0.0_wp 1600 zgcb_out ( :,:) = 0.0_wp 1601 zgcx_out ( :,:) = 0.0_wp 1602 zgcb_wop ( :,:) = 0.0_wp 1603 zgcx_wop ( :,:) = 0.0_wp 1604 zr( :,:) = 0.0_wp 1564 1605 !-------------------------------------------------------------------- 1565 1606 ! Output filename Xn=F(X0) 1566 1607 !-------------------------------------------------------------------- 1567 file_wop='trj_wop_dynspg'1568 1608 CALL tlm_namrd 1569 1609 gamma = h_ratio 1610 file_wop='trj_wop_dynspg' 1611 file_xdx='trj_xdx_dynspg' 1570 1612 !-------------------------------------------------------------------- 1571 1613 ! Initialize the tangent input with random noise: dx … … 1630 1672 END DO 1631 1673 END DO 1674 CALL grid_rd_sd( 596035, zr, c_solver_pt, 0.0_wp, stdgc) 1675 DO jj = nldj, nlej 1676 DO ji = nldi, nlei 1677 zgcb_tlin(ji,jj) = zr(ji,jj) 1678 END DO 1679 END DO 1680 CALL grid_rd_sd( 264792, zr, c_solver_pt, 0.0_wp, stdgc) 1681 DO jj = nldj, nlej 1682 DO ji = nldi, nlei 1683 zgcx_tlin(ji,jj) = zr(ji,jj) 1684 END DO 1685 END DO 1632 1686 ENDIF 1633 1687 … … 1636 1690 !------------------------------------------------------------------- 1637 1691 CALL istate_p 1638 1639 1692 ! *** initialize the reference trajectory 1640 1693 ! ------------ 1641 1694 CALL trj_rea( nit000-1, 1 ) 1642 1695 CALL trj_rea( nit000, 1 ) 1643 1696 ua(:,:,:)=un(:,:,:) 1697 va(:,:,:)=vn(:,:,:) 1698 ub(:,:,:)=un(:,:,:) 1699 vb(:,:,:)=vn(:,:,:) 1700 gcx (:,:) = ua(:,:,1) / 10.0_wp 1701 gcb (:,:) = ua(:,:,3) / 10.0_wp 1644 1702 1645 1703 IF (( cur_loop .NE. 0) .OR. ( gamma .NE. 0.0_wp) )THEN … … 1667 1725 zsshn_tlin(:,:) = gamma * zsshn_tlin(:,:) 1668 1726 sshn(:,:) = sshn(:,:) + zsshn_tlin(:,:) 1727 1728 zgcb_tlin(:,:) = gamma * zgcb_tlin(:,:) 1729 gcb(:,:) = gcb(:,:) + zgcb_tlin(:,:) 1730 1731 zgcx_tlin(:,:) = gamma * zgcx_tlin(:,:) 1732 gcx(:,:) = gcx(:,:) + zgcx_tlin(:,:) 1669 1733 ENDIF 1670 1734 … … 1672 1736 ! Compute the direct model F(X0,t=n) = Xn 1673 1737 !-------------------------------------------------------------------- 1674 CALL dyn_spg_flt(nit000, indic) 1675 IF ( cur_loop .EQ. 0) CALL trj_wri_spl(file_wop) 1738 IF ( tlm_bch /= 2 ) CALL dyn_spg_flt(nit000, indic) 1739 IF ( tlm_bch == 0 ) CALL trj_wri_spl(file_wop) 1740 IF ( tlm_bch == 1 ) CALL trj_wri_spl(file_xdx) 1676 1741 !-------------------------------------------------------------------- 1677 1742 ! Compute the Tangent 1678 1743 !-------------------------------------------------------------------- 1679 IF ( cur_loop .NE. 0) THEN 1680 !-------------------------------------------------------------------- 1681 ! Storing data 1682 !-------------------------------------------------------------------- 1683 zua_out (:,:,:) = ua (:,:,:) 1684 zva_out (:,:,:) = va (:,:,:) 1685 zsshb_out(:,: ) = sshb (:,: ) 1686 zsshn_out(:,: ) = sshn (:,: ) 1744 IF ( tlm_bch == 2 ) THEN 1745 gcx_tl (:,:) = 0.0_wp 1746 gcxb_tl(:,:) = 0.0_wp 1747 gcb_tl (:,:) = 0.0_wp 1687 1748 !-------------------------------------------------------------------- 1688 1749 ! Initialize the tangent variables … … 1698 1759 sshb_tl(:,: ) = zsshb_tlin(:,: ) 1699 1760 sshn_tl(:,: ) = zsshn_tlin(:,: ) 1761 gcb_tl (:,:) = zgcb_tlin (:,:) 1762 gcx_tl (:,:) = zgcx_tlin (:,:) 1700 1763 1701 1764 CALL dyn_spg_flt_tan(nit000, indic) … … 1708 1771 zsp2_3 = DOT_PRODUCT( sshb_tl, sshb_tl ) 1709 1772 zsp2_4 = DOT_PRODUCT( sshn_tl, sshn_tl ) 1710 zsp2 = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4 1773 zsp_5 = DOT_PRODUCT( gcx_tl, gcx_tl ) 1774 zsp_6 = DOT_PRODUCT( gcxb_tl, gcxb_tl ) 1775 1776 zsp2 = zsp2_1 + zsp2_2 + zsp2_3 + zsp2_4 + zsp_5 + zsp_6 1711 1777 !-------------------------------------------------------------------- 1712 1778 ! Storing data … … 1717 1783 zsshb_wop(:,:) = sshb(:,:) 1718 1784 zsshn_wop(:,:) = sshn(:,:) 1785 zgcx_wop (:,:) = gcx (:,:) 1786 CALL trj_rd_spl(file_xdx) 1787 zua_out (:,:,:) = ua (:,:,:) 1788 zva_out (:,:,:) = va (:,:,:) 1789 zsshb_out(:,:) = sshb(:,:) 1790 zsshn_out(:,:) = sshn(:,:) 1791 zgcx_out (:,:) = gcx (:,:) 1719 1792 !-------------------------------------------------------------------- 1720 1793 ! Compute the Linearization Error … … 1809 1882 END DO 1810 1883 END DO 1884 ii=0 1885 DO jj = 1, jpj 1886 DO ji = 1, jpi 1887 zgcx_out (ji,jj) = zgcx_out (ji,jj) - zgcx_wop (ji,jj) 1888 zgcx_wop (ji,jj) = zgcx_out (ji,jj) - gcx_tl (ji,jj) 1889 IF ( gcx_tl(ji,jj) .NE. 0.0_wp ) zerrgcx(ji,jj) = zgcx_out(ji,jj)/gcx_tl(ji,jj) 1890 IF( (MOD(ji, isamp) .EQ. 0) .AND. & 1891 & (MOD(jj, jsamp) .EQ. 0) ) THEN 1892 ii = ii+1 1893 iiposgcx(ii) = ji 1894 ijposgcx(ii) = jj 1895 IF ( INT(tmask(ji,jj,1)) .NE. 0) THEN 1896 zscgcx (ii) = zgcx_wop(ji,jj) 1897 zscerrgcx (ii) = ( zerrgcx(ji,jj) - 1.0_wp ) / gamma 1898 ENDIF 1899 ENDIF 1900 END DO 1901 END DO 1811 1902 zsp1_1 = DOT_PRODUCT( zua_out, zua_out ) 1812 1903 zsp1_2 = DOT_PRODUCT( zva_out, zva_out ) 1813 1904 zsp1_3 = DOT_PRODUCT( zsshb_out, zsshb_out ) 1814 1905 zsp1_4 = DOT_PRODUCT( zsshn_out, zsshn_out ) 1815 zsp1 = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 1906 zsp1_5 = DOT_PRODUCT( zgcx_out, zgcx_out ) 1907 zsp1 = zsp1_1 + zsp1_2 + zsp1_3 + zsp1_4 + zsp1_5 1816 1908 zsp3_1 = DOT_PRODUCT( zua_wop, zua_wop ) 1817 1909 zsp3_2 = DOT_PRODUCT( zva_wop, zva_wop ) 1818 1910 zsp3_3 = DOT_PRODUCT( zsshb_wop, zsshb_wop ) 1819 1911 zsp3_4 = DOT_PRODUCT( zsshn_wop, zsshn_wop ) 1820 zsp3 = zsp3_1 + zsp3_2 + zsp3_3 + zsp3_4 1912 zsp3_5 = DOT_PRODUCT( zgcx_wop, zgcx_wop ) 1913 zsp3 = zsp3_1 + zsp3_2 + zsp3_3 + zsp3_4 + zsp3_5 1821 1914 1822 1915 !-------------------------------------------------------------------- … … 1830 1923 zzsp_3 = SQRT(zsp3_3) 1831 1924 zzsp_4 = SQRT(zsp3_4) 1925 zzsp_5 = SQRT(zsp3_5) 1832 1926 zgsp5 = zzsp 1833 1927 CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) … … 1840 1934 zzsp_3 = SQRT(zsp2_3) 1841 1935 zzsp_4 = SQRT(zsp2_4) 1936 zzsp_5 = SQRT(zsp2_5) 1842 1937 zgsp4 = zzsp 1843 1938 cl_name = 'dynspg_tam:Ln2' … … 1851 1946 zzsp_3 = SQRT(zsp1_3) 1852 1947 zzsp_4 = SQRT(zsp1_4) 1948 zzsp_5 = SQRT(zsp1_5) 1853 1949 cl_name = 'dynspg:Mhdx-Mx' 1854 1950 CALL prntst_tlm( cl_name, kumadt, zzsp, h_ratio ) … … 1918 2014 END SUBROUTINE dyn_spg_flt_tlm_tst 1919 2015 #endif 1920 2016 #endif 1921 2017 #endif 1922 2018 END MODULE dynspg_flt_tam
Note: See TracChangeset
for help on using the changeset viewer.
