- Timestamp:
- 2014-03-26T11:40:29+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/OPATAM_SRC/TRA/trabbl_tam.F90
r3640 r4591 56 56 PUBLIC tra_bbl_adv_adj ! - - - - 57 57 PUBLIC bbl_adj ! routine called by trcbbl.F90 and dtadyn.F90 58 PUBLIC bbl_adj_tst ! routine called by tamtst 58 59 PUBLIC tra_bbl_adj_tst ! routine called by tamtst 59 60 … … 165 166 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl_tan') 166 167 ! 167 IF( l_bbl ) CALL bbl_tan( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 168 IF( l_bbl ) THEN 169 CALL bbl( kt, nit000, 'TRA' ) 170 CALL bbl_tan( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 171 END IF 168 172 169 173 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl … … 247 251 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,ik) 248 252 pta_tl(ji,jj,ik,jn) = pta_tl(ji,jj,ik,jn) & 249 # if defined control_param253 # if defined key_control_param 250 254 & + ( ahu_bbl_tl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 251 255 & - ahu_bbl_tl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & … … 525 529 zub(ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 526 530 zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 531 532 zubtl(ji,jj) = un_tl(ji,jj,mbku(ji,jj)) ! bottom velocity 533 zvbtl(ji,jj) = vn_tl(ji,jj,mbkv(ji,jj)) 527 534 END DO 528 535 END DO … … 699 706 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl_adj') 700 707 ! 701 IF( l_bbl ) CALL bbl_adj( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 708 IF( l_bbl ) CALL bbl( kt, nitend, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 709 710 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 711 ! 712 CALL tra_bbl_adv_adj( tsb, tsb_ad, tsa_ad, jpts ) 713 ! 714 END IF 702 715 703 716 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl … … 707 720 END IF 708 721 709 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 710 ! 711 CALL tra_bbl_adv_adj( tsb, tsb_ad, tsa_ad, jpts ) 712 ! 713 END IF 722 IF( l_bbl ) CALL bbl_adj( kt, nitend, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 714 723 ! 715 724 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_adj') … … 757 766 zptbad(:,:) = 0.0_wp 758 767 ! 759 DO jn = 1, kjpt! tracer loop768 DO jn = kjpt, 1, -1 ! tracer loop 760 769 ! ! =========== 770 # if defined key_control_param 761 771 # if defined key_vectopt_loop 762 772 DO jj = 1, 1 ! vector opt. (forced unrolling) … … 770 780 END DO 771 781 END DO 782 #endif 772 783 ! ! =========== 773 784 ! ! Compute the trend … … 781 792 ik = mbkt(ji,jj) ! bottom T-level index 782 793 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,ik) 783 # if defined control_param794 # if defined key_control_param 784 795 ahu_bbl_ad(ji ,jj ) = ahu_bbl_ad(ji ,jj ) + pta_ad(ji,jj,ik,jn) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) * zbtr 785 796 ahu_bbl_ad(ji-1,jj ) = ahu_bbl_ad(ji-1,jj ) - pta_ad(ji,jj,ik,jn) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) * zbtr … … 805 816 DO ji = 1, jpij 806 817 #else 807 DO jj = 1, jpj808 DO ji = 1, jpi818 DO jj = jpj, 1, -1 819 DO ji = jpi, 1, -1 809 820 #endif 810 821 ik = mbkt(ji,jj) ! bottom T-level index … … 909 920 zu_bblad = zu_bblad + ztraad * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 910 921 ptb_ad(iis,jj,ikus,jn) = ptb_ad(iis,jj,ikus,jn) + ztraad * zu_bbl * zbtr 911 ptb_ad(iid,jj,ikud,jn) = ptb_ad(iid,jj,ikud,jn) +ztraad * zu_bbl * zbtr912 ! 913 DO jk = iku s, ikud-1 ! down-slope upper to down T-point (deep column)922 ptb_ad(iid,jj,ikud,jn) = ptb_ad(iid,jj,ikud,jn) - ztraad * zu_bbl * zbtr 923 ! 924 DO jk = ikud-1, ikus, -1 ! down-slope upper to down T-point (deep column) 914 925 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 915 926 ztraad = pta_ad(iid,jj,jk,jn) … … 1305 1316 ztbad (ji,jj) = 0.0_wp 1306 1317 zsbad (ji,jj) = 0.0_wp 1318 1319 un_ad(ji,jj,mbku(ji,jj)) = un_ad(ji,jj,mbku(ji,jj)) + zubad(ji,jj) 1320 vn_ad(ji,jj,mbkv(ji,jj)) = vn_ad(ji,jj,mbkv(ji,jj)) + zvbad(ji,jj) 1321 zvbad(ji,jj) = 0.0_wp 1322 zubad(ji,jj) = 0.0_wp 1307 1323 END DO 1308 1324 END DO … … 1310 1326 ! 1311 1327 CALL wrk_dealloc( jpi, jpj, zub , zvb , ztb , zsb, zdep, & 1312 & z tbad, zsbad, ztbad, zsbad )1328 & zubad, zvbad, ztbad, zsbad ) 1313 1329 ! 1314 1330 IF( nn_timing == 1 ) CALL timing_stop( 'bbl_adj') … … 1339 1355 ! 1340 1356 END SUBROUTINE tra_bbl_init_tam 1357 1358 SUBROUTINE bbl_adj_tst( kumadt ) 1359 !!----------------------------------------------------------------------- 1360 !! 1361 !! *** ROUTINE tra_bbl_adj_tst *** 1362 !! 1363 !! ** Purpose : Test the adjoint routine. 1364 !! 1365 !! ** Method : Verify the scalar product 1366 !! 1367 !! ( L dx )^T W dy = dx^T L^T W dy 1368 !! 1369 !! where L = tangent routine 1370 !! L^T = adjoint routine 1371 !! W = diagonal matrix of scale factors 1372 !! dx = input perturbation (random field) 1373 !! dy = L dx 1374 !! 1375 !! 1376 !! History : 1377 !! ! 08-08 (A. Vidard) 1378 !!----------------------------------------------------------------------- 1379 !! * Modules used 1380 1381 !! * Arguments 1382 INTEGER, INTENT(IN) :: & 1383 & kumadt ! Output unit 1384 !! * Local declarations 1385 INTEGER :: & 1386 & ji, & ! dummy loop indices 1387 & jj, & 1388 & jk, & 1389 & jtst 1390 INTEGER :: & 1391 & jsav1, & 1392 & jsav2 1393 REAL(KIND=wp) :: & 1394 & zsp1, & ! scalar product involving the tangent routine 1395 & zsp2 ! scalar product involving the adjoint routine 1396 REAL(KIND=wp), POINTER, DIMENSION(:,:,:,:) :: & 1397 & ztsb_tlin , & ! Tangent input 1398 & ztsb_adout, & ! Adjoint input 1399 & zrts ! 2*3D random field 1400 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 1401 & zun_tlin, & 1402 & zvn_tlin, & 1403 & zun_adout, & 1404 & zvn_adout, & 1405 & zr3 ! 3D random field 1406 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 1407 & zahu_tlout, & 1408 & zahv_tlout, & 1409 & zahu_adin , & 1410 & zahv_adin , & 1411 & zutr_tlout, & 1412 & zvtr_tlout, & 1413 & zutr_adin, & 1414 & zvtr_adin, & 1415 & zr2 1416 CHARACTER(LEN=14) :: & 1417 & cl_name 1418 ! Allocate memory 1419 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsb_tlin , ztsb_adout, zrts ) 1420 CALL wrk_alloc( jpi, jpj, jpk, zun_tlin, zvn_tlin, zun_adout, zvn_adout, zr3 ) 1421 CALL wrk_alloc( jpi, jpj, zahu_tlout, zahv_tlout, zahu_adin, zahv_adin, & 1422 & zutr_tlout, zvtr_tlout, zutr_adin, zvtr_adin, zr2 ) 1423 1424 CALL grid_random( utr_bbl(:,:), 'U', 0.0_wp, stdu ) 1425 CALL grid_random( vtr_bbl(:,:), 'V', 0.0_wp, stdv ) 1426 1427 jsav1 = nn_bbl_ldf 1428 jsav2 = nn_bbl_adv 1429 1430 DO jtst = 1, 3 1431 !================================================================== 1432 ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and 1433 ! dy = ( hdivb_tl, hdivn_tl ) 1434 !================================================================== 1435 1436 SELECT CASE( jtst) 1437 CASE ( 1 ) 1438 nn_bbl_ldf = 1 1439 nn_bbl_adv = 0 1440 CASE ( 2 ) 1441 nn_bbl_ldf = 0 1442 nn_bbl_adv = 1 1443 CASE ( 3 ) 1444 nn_bbl_ldf = 0 1445 nn_bbl_adv = 2 1446 END SELECT 1447 !-------------------------------------------------------------------- 1448 ! Reset the tangent and adjoint variables 1449 !-------------------------------------------------------------------- 1450 ztsb_tlin = 0.0_wp 1451 zun_tlin = 0.0_wp 1452 zvn_tlin = 0.0_wp 1453 zahu_adin = 0.0_wp 1454 zahv_adin = 0.0_wp 1455 zutr_adin = 0.0_wp 1456 zvtr_adin = 0.0_wp 1457 1458 ahu_bbl_tl = 0.0_wp 1459 ahv_bbl_tl = 0.0_wp 1460 utr_bbl_tl = 0.0_wp 1461 vtr_bbl_tl = 0.0_wp 1462 1463 un_ad = 0.0_wp 1464 vn_ad = 0.0_wp 1465 tsb_ad = 0.0_wp 1466 1467 !-------------------------------------------------------------------- 1468 ! Initialize the tangent input with random noise: dx 1469 !-------------------------------------------------------------------- 1470 1471 CALL grid_random( zrts(:,:,:,jp_tem), 'T', 0.0_wp, stdt ) 1472 CALL grid_random( zrts(:,:,:,jp_sal), 'T', 0.0_wp, stds ) 1473 DO jk = 1, jpk 1474 DO jj = nldj, nlej 1475 DO ji = nldi, nlei 1476 ztsb_tlin(ji,jj,jk,:) = zrts(ji,jj,jk,:) 1477 END DO 1478 END DO 1479 END DO 1480 1481 CALL grid_random( zr3(:,:,:), 'U', 0.0_wp, stdu ) 1482 DO jk = 1, jpk 1483 DO jj = nldj, nlej 1484 DO ji = nldi, nlei 1485 zun_tlin(ji,jj,jk) = zr3(ji,jj,jk) 1486 END DO 1487 END DO 1488 END DO 1489 1490 CALL grid_random( zr3(:,:,:), 'V', 0.0_wp, stdv ) 1491 DO jk = 1, jpk 1492 DO jj = nldj, nlej 1493 DO ji = nldi, nlei 1494 zvn_tlin(ji,jj,jk) = zr3(ji,jj,jk) 1495 END DO 1496 END DO 1497 END DO 1498 1499 tsb_tl(:,:,:,:) = ztsb_tlin(:,:,:,:) 1500 un_tl(:,:,:) = zun_tlin(:,:,:) 1501 vn_tl(:,:,:) = zvn_tlin(:,:,:) 1502 1503 CALL bbl_tan (0, 1, 'TRA') 1504 1505 zahu_tlout(:,:) = ahu_bbl_tl(:,:) 1506 zahv_tlout(:,:) = ahv_bbl_tl(:,:) 1507 zutr_tlout(:,:) = utr_bbl_tl(:,:) 1508 zvtr_tlout(:,:) = vtr_bbl_tl(:,:) 1509 1510 DO jj = nldj, nlej 1511 DO ji = nldi, nlei 1512 zahu_adin(ji,jj) = zahu_tlout(ji,jj) & 1513 & * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) & 1514 & * umask(ji,jj,1) 1515 zahv_adin(ji,jj) = zahv_tlout(ji,jj) & 1516 & * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) & 1517 & * vmask(ji,jj,1) 1518 zutr_adin(ji,jj) = zutr_tlout(ji,jj) & 1519 & * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) & 1520 & * umask(ji,jj,1) 1521 zvtr_adin(ji,jj) = zvtr_tlout(ji,jj) & 1522 & * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) & 1523 & * vmask(ji,jj,1) 1524 END DO 1525 END DO 1526 !-------------------------------------------------------------------- 1527 ! Compute the scalar product: ( L dx )^T W dy 1528 !-------------------------------------------------------------------- 1529 1530 zsp1 = DOT_PRODUCT( zahu_tlout, zahu_adin ) & 1531 & + DOT_PRODUCT( zutr_tlout, zutr_adin ) & 1532 & + DOT_PRODUCT( zahv_tlout, zahv_adin ) & 1533 & + DOT_PRODUCT( zvtr_tlout, zvtr_adin ) 1534 1535 !-------------------------------------------------------------------- 1536 ! Call the adjoint routine: dx^* = L^T dy^* 1537 !-------------------------------------------------------------------- 1538 1539 ahu_bbl_ad(:,:) = zahu_adin(:,:) 1540 ahv_bbl_ad(:,:) = zahv_adin(:,:) 1541 utr_bbl_ad(:,:) = zutr_adin(:,:) 1542 vtr_bbl_ad(:,:) = zvtr_adin(:,:) 1543 1544 CALL bbl_adj (0, 1, 'TRA') 1545 1546 ztsb_adout = tsb_ad 1547 zun_adout = un_ad 1548 zvn_adout = vn_ad 1549 1550 zsp2 = DOT_PRODUCT( ztsb_tlin(:,:,:,jp_tem), ztsb_adout(:,:,:,jp_tem) ) & 1551 & + DOT_PRODUCT( ztsb_tlin(:,:,:,jp_sal), ztsb_adout(:,:,:,jp_sal) ) & 1552 & + DOT_PRODUCT( zun_tlin (:,:,: ), zun_adout (:,:,: ) ) & 1553 & + DOT_PRODUCT( zvn_tlin (:,:,: ), zvn_adout (:,:,: ) ) 1554 1555 SELECT CASE ( jtst ) 1556 CASE ( 1 ) 1557 ! 14 char:'12345678901234' 1558 cl_name = 'bbl_adj_dif ' 1559 CASE ( 2 ) 1560 ! 14 char:'12345678901234' 1561 cl_name = 'bbl_adj_adv 1' 1562 CASE ( 3 ) 1563 ! 14 char:'12345678901234' 1564 cl_name = 'bbl_adj_adv 2' 1565 END SELECT 1566 CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 ) 1567 1568 END DO 1569 1570 nn_bbl_ldf = jsav1 1571 nn_bbl_adv = jsav2 1572 1573 1574 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsb_tlin , ztsb_adout, zrts ) 1575 CALL wrk_dealloc( jpi, jpj, jpk, zun_tlin, zvn_tlin, zun_adout, zvn_adout, zr3 ) 1576 CALL wrk_dealloc( jpi, jpj, zahu_tlout, zahv_tlout, zahu_adin, zahv_adin, & 1577 & zutr_tlout, zvtr_tlout, zutr_adin, zvtr_adin, zr2 ) 1578 1579 END SUBROUTINE bbl_adj_tst 1341 1580 1342 1581 SUBROUTINE tra_bbl_adj_tst( kumadt ) … … 1387 1626 & ztsb_adout, & 1388 1627 & zrts ! 2*3D random field 1389 REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 1390 & zutr_tlin , & 1391 & zutr_tlout, & 1392 & zvtr_tlin , & 1393 & zvtr_tlout, & 1394 & zutr_adout, & 1395 & zutr_adin , & 1396 & zvtr_adout, & 1397 & zvtr_adin , & 1398 & zr2 ! 2D random field 1628 REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 1629 & zun_tlin, & 1630 & zvn_tlin, & 1631 & zun_adout, & 1632 & zvn_adout, & 1633 & zr3 ! 3D random field 1399 1634 CHARACTER(LEN=14) :: & 1400 1635 & cl_name … … 1404 1639 & ztsa_adout, ztsa_adin , ztsb_adout, & 1405 1640 & zrts ) 1406 CALL wrk_alloc( jpi, jpj, zutr_tlin , zutr_tlout, zvtr_tlin , zvtr_tlout, & 1407 & zutr_adout, zutr_adin , zvtr_adout, zvtr_adin , & 1408 & zr2 ) 1641 CALL wrk_alloc( jpi, jpj, jpk, zun_tlin, zvn_tlin, zun_adout, zvn_adout, zr3 ) 1409 1642 1410 1643 CALL grid_random( utr_bbl(:,:), 'U', 0.0_wp, stdu ) … … 1414 1647 jsav2 = nn_bbl_adv 1415 1648 1416 DO jtst = 1, 21649 DO jtst = 1, 3 1417 1650 !================================================================== 1418 1651 ! 1) dx = ( un_tl, vn_tl, hdivn_tl ) and … … 1441 1674 ztsb_adout(:,:,:,:) = 0.0_wp 1442 1675 1443 zutr_tlin (:,:) = 0.0_wp 1444 zutr_tlout(:,:) = 0.0_wp 1445 zvtr_tlin (:,:) = 0.0_wp 1446 zvtr_tlout(:,:) = 0.0_wp 1447 zutr_adout(:,:) = 0.0_wp 1448 zutr_adin (:,:) = 0.0_wp 1449 zvtr_adout(:,:) = 0.0_wp 1450 zvtr_adin (:,:) = 0.0_wp 1451 1676 zun_tlin (:,:,:) = 0.0_wp 1677 zun_adout(:,:,:) = 0.0_wp 1678 zvn_tlin (:,:,:) = 0.0_wp 1679 zvn_adout(:,:,:) = 0.0_wp 1680 1681 tsb_tl(:,:,:,:) = 0.0_wp 1682 tsa_tl(:,:,:,:) = 0.0_wp 1452 1683 tsb_ad(:,:,:,:) = 0.0_wp 1684 tsa_ad(:,:,:,:) = 0.0_wp 1685 1686 un_tl(:,:,:) = 0.0_wp 1687 vn_tl(:,:,:) = 0.0_wp 1688 un_ad(:,:,:) = 0.0_wp 1689 vn_ad(:,:,:) = 0.0_wp 1453 1690 !-------------------------------------------------------------------- 1454 1691 ! Initialize the tangent input with random noise: dx … … 1475 1712 END DO 1476 1713 1477 CALL grid_random( zr2(:,:), 'U', 0.0_wp, stdu ) 1714 CALL grid_random( zr3(:,:,:), 'U', 0.0_wp, stdu ) 1715 DO jk = 1, jpk 1478 1716 DO jj = nldj, nlej 1479 1717 DO ji = nldi, nlei 1480 zutr_tlin(ji,jj) = zr2(ji,jj) 1481 END DO 1482 END DO 1483 1484 CALL grid_random( zr2(:,:), 'V', 0.0_wp, stdv ) 1718 zun_tlin(ji,jj,jk) = zr3(ji,jj,jk) 1719 END DO 1720 END DO 1721 END DO 1722 1723 CALL grid_random( zr3(:,:,:), 'V', 0.0_wp, stdv ) 1724 DO jk = 1, jpk 1485 1725 DO jj = nldj, nlej 1486 1726 DO ji = nldi, nlei 1487 zvtr_tlin(ji,jj) = zr2(ji,jj) 1488 END DO 1727 zvn_tlin(ji,jj,jk) = zr3(ji,jj,jk) 1728 END DO 1729 END DO 1489 1730 END DO 1490 1731 1491 1732 tsa_tl(:,:,:,:) = ztsa_tlin(:,:,:,:) 1492 1733 tsb_tl(:,:,:,:) = ztsb_tlin(:,:,:,:) 1493 utr_bbl_tl(:,:) = zutr_tlin(:,:) 1494 vtr_bbl_tl(:,:) = zvtr_tlin(:,:) 1734 un_tl(:,:,:) = zun_tlin(:,:,:) 1735 vn_tl(:,:,:) = zvn_tlin(:,:,:) 1736 1495 1737 CALL tra_bbl_tan ( nit000 ) 1496 1738 ztsa_tlout(:,:,:,:) = tsa_tl(:,:,:,:) 1497 zutr_tlout(:,:) = utr_bbl_tl(:,:)1498 zvtr_tlout(:,:) = vtr_bbl_tl(:,:)1499 1739 !-------------------------------------------------------------------- 1500 1740 ! Initialize the adjoint variables: dy^* = W dy … … 1513 1753 END DO 1514 1754 END DO 1515 DO jj = nldj, nlej1516 DO ji = nldi, nlei1517 zutr_adin(ji,jj) = zutr_tlout(ji,jj) &1518 & * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) &1519 & * vmask(ji,jj,jk)1520 zvtr_adin(ji,jj) = zvtr_tlout(ji,jj) &1521 & * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) &1522 & * vmask(ji,jj,jk)1523 END DO1524 END DO1525 1755 !-------------------------------------------------------------------- 1526 1756 ! Compute the scalar product: ( L dx )^T W dy … … 1528 1758 1529 1759 zsp1 = DOT_PRODUCT( ztsa_tlout(:,:,:,jp_tem), ztsa_adin(:,:,:,jp_tem) ) & 1530 & + DOT_PRODUCT( ztsa_tlout(:,:,:,jp_sal), ztsa_adin(:,:,:,jp_sal) ) & 1531 & + DOT_PRODUCT( zutr_tlout, zutr_adin ) + DOT_PRODUCT( zvtr_tlout, zvtr_adin ) 1760 & + DOT_PRODUCT( ztsa_tlout(:,:,:,jp_sal), ztsa_adin(:,:,:,jp_sal) ) 1532 1761 1533 1762 !-------------------------------------------------------------------- … … 1536 1765 1537 1766 tsa_ad(:,:,:,:) = ztsa_adin(:,:,:,:) 1538 utr_bbl_ad(:,:) = zutr_adin(:,:)1539 vtr_bbl_ad(:,:) = zvtr_adin(:,:)1540 1767 CALL tra_bbl_adj ( nit000 ) 1541 1768 ztsa_adout(:,:,:,:) = tsa_ad(:,:,:,:) 1542 1769 ztsb_adout(:,:,:,:) = tsb_ad(:,:,:,:) 1543 zutr_adout(:,:) = utr_bbl_ad(:,:) 1544 zvtr_adout(:,:) = vtr_bbl_ad(:,:) 1545 1770 zun_adout(:,:,:) = un_ad (:,:,:) 1771 zvn_adout(:,:,:) = vn_ad (:,:,:) 1546 1772 1547 1773 zsp2 = DOT_PRODUCT( ztsa_tlin(:,:,:,jp_tem), ztsa_adout(:,:,:,jp_tem) ) & … … 1549 1775 & + DOT_PRODUCT( ztsb_tlin(:,:,:,jp_tem), ztsb_adout(:,:,:,jp_tem) ) & 1550 1776 & + DOT_PRODUCT( ztsb_tlin(:,:,:,jp_sal), ztsb_adout(:,:,:,jp_sal) ) & 1551 & + DOT_PRODUCT( zutr_tlin, zutr_adout ) + DOT_PRODUCT( zvtr_tlin, zvtr_adout ) 1777 & + DOT_PRODUCT( zun_tlin (:,:,: ), zun_adout (:,:,: ) ) & 1778 & + DOT_PRODUCT( zvn_tlin (:,:,: ), zvn_adout (:,:,: ) ) 1552 1779 1553 1780 SELECT CASE ( jtst ) … … 1569 1796 & ztsa_adout, ztsa_adin , ztsb_adout, & 1570 1797 & zrts ) 1571 CALL wrk_dealloc( jpi, jpj, zutr_tlin , zutr_tlout, zvtr_tlin , zvtr_tlout, & 1572 & zutr_adout, zutr_adin , zvtr_adout, zvtr_adin , & 1573 & zr2 ) 1798 CALL wrk_dealloc( jpi, jpj, jpk, zun_tlin, zvn_tlin, zun_adout, zvn_adout, zr3 ) 1574 1799 1575 1800 nn_bbl_ldf = jsav1
Note: See TracChangeset
for help on using the changeset viewer.
