- Timestamp:
- 2015-05-27T18:17:08+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5220 r5299 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb, fraqsr_1lev 36 36 USE albedo ! 37 37 USE in_out_manager ! I/O manager … … 98 98 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 99 99 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 100 INTEGER, PARAMETER :: jprcv = 40 ! total number of fields received 101 102 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 100 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 101 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 102 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 103 104 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 103 105 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 104 106 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature … … 125 127 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 126 128 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 127 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent twice if atmos and ice coupled via OASIS 128 INTEGER, PARAMETER :: jpsnd = 26 ! total number of fields sended 129 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 130 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 131 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 132 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 129 133 130 134 ! !!** namelist namsbc_cpl ** … … 156 160 157 161 !! Substitution 162 # include "domzgr_substitute.h90" 158 163 # include "vectopt_loop_substitute.h90" 159 164 !!---------------------------------------------------------------------- … … 229 234 IF(lwm) WRITE ( numond, namsbc_cpl ) 230 235 231 IF(lwp .AND. nn_components /= jp_iam_opa) THEN ! control print236 IF(lwp) THEN ! control print 232 237 WRITE(numout,*) 233 238 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 234 239 WRITE(numout,*)'~~~~~~~~~~~~' 240 ENDIF 241 IF( lwp .AND. nn_components /= jp_iam_opa .AND. ln_cpl ) THEN ! control print 235 242 WRITE(numout,*)' received fields (mutiple ice categogies)' 236 243 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 472 479 srcv(jpr_sflx)%clname = 'O_SFLX' 473 480 srcv(jpr_fice)%clname = 'RIceFrc' 474 ! ! -------------------------------- ! 475 ! ! OPA-SAS coupling - rcv by sas ! 476 ! ! -------------------------------- ! 477 srcv(jpr_toce)%clname = 'I_SSTSST' 478 srcv(jpr_soce)%clname = 'I_SSSal' 479 srcv(jpr_ocx1)%clname = 'I_OCurx1' 480 srcv(jpr_ocy1)%clname = 'I_OCury1' 481 srcv(jpr_ssh)%clname = 'I_SSHght' 482 481 ! 483 482 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 484 483 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 485 srcv(jpr_fice )%laction = .TRUE. 486 srcv( (/jpr_taum, jpr_otx1, jpr_oty1 /) )%laction = .TRUE. 487 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 488 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 484 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 485 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 486 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 489 487 sn_rcv_tau%clvgrd = 'U,V' 490 488 sn_rcv_tau%clvor = 'local grid' 491 489 sn_rcv_tau%clvref = 'spherical' 492 srcv( (/jpr_qsroce, jpr_qnsoce /) )%laction = .TRUE.493 srcv( (/jpr_oemp, jpr_sflx/) )%laction = .TRUE.494 490 sn_rcv_emp%cldes = 'oce only' 491 ! 495 492 IF(lwp) THEN ! control print 496 493 WRITE(numout,*) 497 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '498 494 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 499 495 WRITE(numout,*)' OPA component ' … … 509 505 WRITE(numout,*) 510 506 ENDIF 511 ELSE IF( nn_components == jp_iam_sas ) THEN 507 ENDIF 508 ! ! -------------------------------- ! 509 ! ! OPA-SAS coupling - rcv by sas ! 510 ! ! -------------------------------- ! 511 srcv(jpr_toce )%clname = 'I_SSTSST' 512 srcv(jpr_soce )%clname = 'I_SSSal' 513 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 514 srcv(jpr_ocy1 )%clname = 'I_OCury1' 515 srcv(jpr_ssh )%clname = 'I_SSHght' 516 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 517 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 518 ! 519 IF( nn_components == jp_iam_sas ) THEN 512 520 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 513 srcv(jpr_toce )%laction = .TRUE. ; srcv(jpr_soce )%laction = .TRUE. ; srcv(jpr_ocx1 )%laction = .TRUE. ; 514 srcv(jpr_ocy1 )%laction = .TRUE. ; srcv(jpr_ssh )%laction = .TRUE. 521 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_e3t1st, jpr_fraqsr, jpr_ocx1, jps_ocy1/) )%laction = .TRUE. 515 522 ! Vectors: change of sign at north fold ONLY if on the local grid 516 523 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. … … 519 526 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 520 527 END DO 528 ! 521 529 IF(lwp) THEN ! control print 530 WRITE(numout,*) 531 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 532 WRITE(numout,*)' SAS component ' 533 WRITE(numout,*) 522 534 IF( .NOT. ln_cpl ) THEN 523 WRITE(numout,*)524 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '525 WRITE(numout,*)' Special conditions for SAS-OPA coupling '526 WRITE(numout,*)' SAS component '527 WRITE(numout,*)528 535 WRITE(numout,*)' received fields from OPA component ' 529 536 ELSE 530 WRITE(numout,*)531 WRITE(numout,*)' Special conditions for SAS-OPA coupling '532 WRITE(numout,*)' SAS component '533 WRITE(numout,*)534 537 WRITE(numout,*)' Additional received fields from OPA component : ' 535 538 ENDIF 536 WRITE(numout,*)' sea surface temperature ( T before,Celcius) '539 WRITE(numout,*)' sea surface temperature (Celcius) ' 537 540 WRITE(numout,*)' sea surface salinity ' 538 541 WRITE(numout,*)' surface currents ' 539 542 WRITE(numout,*)' sea surface height ' 543 WRITE(numout,*)' thickness of first ocean T level ' 544 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 540 545 WRITE(numout,*) 541 546 ENDIF 542 547 ENDIF 543 ! Allocate all parts of frcv used for received fields 548 549 ! =================================================== ! 550 ! Allocate all parts of frcv used for received fields ! 551 ! =================================================== ! 544 552 DO jn = 1, jprcv 545 553 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) … … 549 557 ! Allocate w10m part of frcv which is used even when not received as coupling field 550 558 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 559 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 560 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 561 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 551 562 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 552 563 IF( k_ice /= 0 ) THEN … … 666 677 ! ! OPA-SAS coupling - snd by opa ! 667 678 ! ! ------------------------------- ! 668 ssnd(jps_ssh )%clname = 'O_SSHght' 669 ssnd(jps_soce)%clname = 'O_SSSal' 679 ssnd(jps_ssh )%clname = 'O_SSHght' 680 ssnd(jps_soce )%clname = 'O_SSSal' 681 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 682 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 683 ! 684 IF( nn_components == jp_iam_opa ) THEN 685 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 686 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_e3t1st, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 687 ! vector definition: not used but cleaner... 688 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 689 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 690 sn_snd_crt%clvgrd = 'U,V' 691 sn_snd_crt%clvor = 'local grid' 692 sn_snd_crt%clvref = 'spherical' 693 ! 694 IF(lwp) THEN ! control print 695 WRITE(numout,*) 696 WRITE(numout,*)' sent fields to SAS component ' 697 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 698 WRITE(numout,*)' sea surface salinity ' 699 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 700 WRITE(numout,*)' sea surface height ' 701 WRITE(numout,*)' thickness of first ocean T level ' 702 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 703 WRITE(numout,*) 704 ENDIF 705 ENDIF 670 706 ! ! ------------------------------- ! 671 707 ! ! OPA-SAS coupling - snd by sas ! … … 680 716 ssnd(jps_rnf )%clname = 'I_Runoff' 681 717 ssnd(jps_taum )%clname = 'I_TauMod' 682 683 ! NEMO coupled to sea ice with OASIS 684 IF( nn_components == jp_iam_opa ) THEN 685 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 686 ssnd( jps_ssh )%laction = .TRUE. ; ssnd(jps_soce)%laction = .TRUE. 687 ssnd( jps_toce )%laction = .TRUE. ; ssnd( (/jps_ocx1,jps_ocy1/) )%laction = .TRUE. 688 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 689 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 690 sn_snd_crt%clvgrd = 'U,V' 691 sn_snd_crt%clvor = 'local grid' 692 sn_snd_crt%clvref = 'spherical' 693 IF(lwp) THEN ! control print 694 WRITE(numout,*) 695 WRITE(numout,*)' sent fields to SAS component ' 696 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 697 WRITE(numout,*)' sea surface salinity ' 698 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 699 WRITE(numout,*)' sea surface height ' 700 WRITE(numout,*) 701 ENDIF 702 ! Sea ice coupled to NEMO with OASIS 703 ELSE IF( nn_components == jp_iam_sas ) THEN 718 ! 719 IF( nn_components == jp_iam_sas ) THEN 704 720 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 705 ssnd(jps_qsroce)%laction = .TRUE. ; ssnd(jps_qnsoce)%laction = .TRUE. ; ssnd(jps_oemp)%laction = .TRUE. 706 ssnd(jps_sflx )%laction = .TRUE. ; ssnd(jps_otx1 )%laction = .TRUE. ; ssnd(jps_oty1)%laction = .TRUE. 707 ssnd(jps_taum )%laction = .TRUE. 708 ssnd(jps_fice2)%laction = .TRUE. ! fr_i defined in sas, even if nn_ice == 0 709 sn_snd_thick%clcat = 'no' 710 IF (.NOT. ln_cpl) ssnd(jps_fice)%laction = .FALSE. 721 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 722 ! 711 723 ! Change first letter to couple with atmosphere if already coupled with sea_ice 724 ! this is nedeed as each variable name used in the namcouple must be unique: 725 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 712 726 DO jn = 1, jpsnd 713 727 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 714 728 END DO 729 ! 715 730 IF(lwp) THEN ! control print 731 WRITE(numout,*) 716 732 IF( .NOT. ln_cpl ) THEN 717 WRITE(numout,*)718 733 WRITE(numout,*)' sent fields to OPA component ' 719 734 ELSE 720 WRITE(numout,*)721 735 WRITE(numout,*)' Additional sent fields to OPA component : ' 722 WRITE(numout,*)' ice cover '723 WRITE(numout,*)' oce only EMP '724 WRITE(numout,*)' salt flux '725 WRITE(numout,*)' mixed oce-ice solar flux '726 WRITE(numout,*)' mixed oce-ice non solar flux '727 WRITE(numout,*)' wind stress U,V components'728 WRITE(numout,*)' wind stress module'729 736 ENDIF 737 WRITE(numout,*)' ice cover ' 738 WRITE(numout,*)' oce only EMP ' 739 WRITE(numout,*)' salt flux ' 740 WRITE(numout,*)' mixed oce-ice solar flux ' 741 WRITE(numout,*)' mixed oce-ice non solar flux ' 742 WRITE(numout,*)' wind stress U,V components' 743 WRITE(numout,*)' wind stress module' 730 744 ENDIF 731 745 ENDIF … … 891 905 ! 892 906 ENDIF 893 894 907 ! ! ========================= ! 895 908 ! ! wind stress module ! (taum) … … 920 933 ENDIF 921 934 ENDIF 922 935 ! 923 936 ! ! ========================= ! 924 937 ! ! 10 m wind speed ! (wndm) … … 984 997 ! ! SSH ! 985 998 ! ! ================== ! 986 IF( srcv(jpr_ssh )%laction ) ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 987 999 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1000 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1001 sshn( :,:) = ssh_m(:,:) 1002 ENDIF 988 1003 ! ! ================== ! 989 1004 ! ! surface currents ! 990 1005 ! ! ================== ! 991 IF( srcv(jpr_ocx1)%laction ) THEN 1006 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 992 1007 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 993 ub (:,:,1 1008 ub (:,:,1) = ssu_m(:,:) 994 1009 ENDIF 995 1010 IF( srcv(jpr_ocy1)%laction ) THEN 996 1011 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 997 vb (:,:,1 ) = ssv_m(:,:) 1012 vb (:,:,1) = ssv_m(:,:) 1013 ENDIF 1014 ! ! ======================== ! 1015 ! ! first T level thickness ! 1016 ! ! ======================== ! 1017 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1018 fse3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1019 ENDIF 1020 ! ! ================================ ! 1021 ! ! fraction of solar net radiation ! 1022 ! ! ================================ ! 1023 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1024 fraqsr_1lev(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 998 1025 ENDIF 999 1026 … … 1153 1180 ! 1154 1181 ENDIF 1155 1156 1182 ! ! ======================= ! 1157 1183 ! ! put on ice grid ! … … 1584 1610 INTEGER :: ji, jj, jl ! dummy loop indices 1585 1611 INTEGER :: isec, info ! local integer 1612 REAL(wp) :: zumax, zvmax 1586 1613 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1587 1614 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 … … 1601 1628 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1602 1629 IF ( nn_components == jp_iam_opa ) THEN 1603 ztmp1(:,:) = ts b(:,:,1,jp_tem)1630 ztmp1(:,:) = tsn(:,:,1,jp_tem) 1604 1631 ELSE 1605 1632 SELECT CASE( sn_snd_temp%cldes) … … 1645 1672 ! ! Ice fraction & Thickness ! 1646 1673 ! ! ------------------------- ! 1647 ! Send ice fraction field 1648 IF( ssnd(jps_fice)%laction .OR. ssnd(jps_fice2)%laction) THEN1674 ! Send ice fraction field to atmosphere 1675 IF( ssnd(jps_fice)%laction ) THEN 1649 1676 SELECT CASE( sn_snd_thick%clcat ) 1650 1677 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) … … 1652 1679 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1653 1680 END SELECT 1654 IF( ssnd(jps_fice )%laction ) CALL cpl_snd( jps_fice , isec, ztmp3, info ) 1681 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1682 ENDIF 1683 1684 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1685 IF( ssnd(jps_fice2)%laction ) THEN 1686 ztmp3(:,:,1) = fr_i(:,:) 1655 1687 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1656 1688 ENDIF … … 1702 1734 ! i i+1 (for I) 1703 1735 IF( nn_components == jp_iam_opa ) THEN 1704 zotx1(:,:) = u b(:,:,1)1705 zoty1(:,:) = v b(:,:,1)1736 zotx1(:,:) = un(:,:,1) 1737 zoty1(:,:) = vn(:,:,1) 1706 1738 ELSE 1707 1739 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) … … 1826 1858 ! 1827 1859 ! 1828 ! Fields sent to ice by ocean model when OASIS coupling1860 ! Fields sent to SAS by OPA when doing OPA<->SAS coupling 1829 1861 ! ! SSH 1830 1862 IF( ssnd(jps_ssh )%laction ) THEN … … 1832 1864 ! forcing is used (for sea-ice dynamics) 1833 1865 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 1834 ELSE ; ztmp1(:,:) = ssh b(:,:)1866 ELSE ; ztmp1(:,:) = sshn(:,:) 1835 1867 ENDIF 1836 1868 CALL cpl_snd( jps_ssh, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) … … 1838 1870 ENDIF 1839 1871 ! ! SSS 1840 IF( ssnd(jps_soce)%laction ) THEN 1841 ztmp1(:,:) = tsb(:,:,1,jp_sal) 1842 CALL cpl_snd( jps_soce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1872 IF( ssnd(jps_soce )%laction ) THEN 1873 ztmp1(:,:) = tsn(:,:,1,jp_sal) 1874 CALL cpl_snd( jps_soce , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1875 ENDIF 1876 ! ! first T level thickness 1877 IF( ssnd(jps_e3t1st )%laction ) THEN 1878 ztmp1(:,:) = fse3t_n(:,:,1) 1879 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1880 ENDIF 1881 ! ! Qsr fraction 1882 IF( ssnd(jps_fraqsr)%laction ) THEN 1883 ztmp1(:,:) = fraqsr_1lev(:,:) 1884 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1843 1885 ENDIF 1844 1886 !
Note: See TracChangeset
for help on using the changeset viewer.
