Changeset 1226


Ignore:
Timestamp:
2008-11-27T18:41:45+01:00 (13 years ago)
Author:
smasson
Message:

bugfix of the coupling interface (commited during changeset:1218), see ticket:155

Location:
trunk/NEMO
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/LIM_SRC_2/limsbc_2.F90

    r1218 r1226  
    159159            !   computation the solar flux at ocean surface 
    160160#if defined key_coupled  
    161             zqsr = tqsr(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj) ) * ( 1.0 - pfrld(ji,jj) ) 
     161            zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj) ) * ( 1.0 - pfrld(ji,jj) ) 
    162162#else 
    163163            zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
  • trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r1218 r1226  
    4444   INTEGER                    :: nerror            ! return error code 
    4545 
    46    INTEGER, PUBLIC :: nrcv, nsnd    ! Number of received and sent coupling fields 
    47  
    4846   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields 
    4947    
     
    7573CONTAINS 
    7674 
    77    SUBROUTINE cpl_prism_init 
     75   SUBROUTINE cpl_prism_init (kl_comm)  
    7876 
    7977      !!------------------------------------------------------------------- 
     
    8583      !! ** Method  :   OASIS3 MPI communication  
    8684      !!-------------------------------------------------------------------- 
    87       !! 
     85      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model 
     86      !!-------------------------------------------------------------------- 
    8887 
    8988      IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case' 
     
    101100      !------------------------------------------------------------------ 
    102101 
    103       CALL prism_get_localcomm_proto ( nlocalComm, nerror ) 
     102      CALL prism_get_localcomm_proto ( kl_comm, nerror ) 
    104103      IF ( nerror /= PRISM_Ok ) & 
    105104         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
     
    108107 
    109108 
    110    SUBROUTINE cpl_prism_define () 
     109   SUBROUTINE cpl_prism_define (krcv, ksnd) 
    111110 
    112111      !!------------------------------------------------------------------- 
     
    118117      !! ** Method  :   OASIS3 MPI communication  
    119118      !!-------------------------------------------------------------------- 
    120       !! * Arguments 
    121       !! 
    122       !! * Local declarations 
    123       !! 
     119      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields 
     120      ! 
    124121      INTEGER                    :: id_part 
    125122      INTEGER                    :: paral(5)       ! OASIS3 box partition 
     
    171168      ! ... Announce send variables.  
    172169      ! 
    173       DO ji = 1, nsnd 
     170      DO ji = 1, ksnd 
    174171         IF ( ssnd(ji)%laction ) THEN  
    175172            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  & 
     
    184181      ! ... Announce received variables.  
    185182      ! 
    186       DO ji = 1, nrcv 
     183      DO ji = 1, krcv 
    187184         IF ( srcv(ji)%laction ) THEN  
    188185            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   & 
     
    292289            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    293290            WRITE(numout,*) '****************' 
    294             call flush(numout) 
    295291         ENDIF 
    296292       
     
    329325CONTAINS 
    330326 
    331    SUBROUTINE cpl_prism_init 
     327   SUBROUTINE cpl_prism_init (kl_comm)  
     328      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model 
     329      kl_comm = -1 
    332330      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
    333331   END SUBROUTINE cpl_prism_init 
  • trunk/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r1218 r1226  
    1919 
    2020#if defined key_lim3  
    21    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
    22    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
    23    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice      !: ice surface temperature       [K] 
     21   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice   !: non solar heat flux over ice  [W/m2] 
     22   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice   !: solar heat flux over ice      [W/m2] 
     23   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice 
     24   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqla_ice  !: latent sensibility over ice 
     25   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice    !: ice surface temperature       [K] 
    2527   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice 
    2628#else 
    2729   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
    2830   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
     31   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qla_ice     !: latent flux over ice 
     32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqla_ice    !: latent sensibility over ice 
    2933   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    3034   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tn_ice      !: ice surface temperature       [K] 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice       !: albedo of ice 
     35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice     !: albedo of ice 
    3236#endif 
    3337 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip     !: total precipitation           [Kg/m2/s] 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip     !: solid precipitation           [Kg/m2/s] 
    3638   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utaui_ice   !: u-stress over ice (I-point)   [N/m2] 
    3739   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtaui_ice   !: v-stress over ice (I-point)   [N/m2] 
    3840   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad.  which penetrate inside the ice cover 
    3941   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad.  which penetrate inside the ice cover 
    40  
    41 #if ! defined key_coupled 
    42  
    43 # if defined key_lim3  
    44    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqla_ice  !: latent sensibility over ice 
    46 # else 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qla_ice   !: latent flux over ice 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqla_ice  !: latent sensibility over ice 
    49 # endif 
    50  
    51 #else 
    52  
    53 !!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff 
    54 !!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving 
    55  
    56 #endif 
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
    5743 
    5844#else 
  • trunk/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r1220 r1226  
    4040   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau      !: sea surface j-stress (ocean referential)     [N/m2] 
    4141   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm      !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr       !: sea heat flux:     solar                     [W/m2] 
    4243   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns       !: sea heat flux: non solar                     [W/m2] 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr       !: sea heat flux:     solar                     [W/m2] 
     44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot   !: total     solar heat flux (over sea and ice) [W/m2] 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot   !: total non solar heat flux (over sea and ice) [W/m2] 
    4446   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp       !: freshwater budget: volume flux               [Kg/m2/s] 
    4547   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps      !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot   !: total evaporation - (liquid + solid) precpitation over oce and ice 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip   !: total precipitation           [Kg/m2/s] 
     50   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip   !: solid precipitation           [Kg/m2/s] 
     51!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff 
     52!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving 
    4653   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i      !: ice fraction  (between 0 to 1)               - 
    4754 
  • trunk/NEMO/OPA_SRC/SBC/sbccpl.F90

    r1218 r1226  
    2727   USE par_ice         ! ice parameters 
    2828#endif 
     29#if defined key_lim2 
     30   USE ice_2, ONLY : hicif, hsnif          ! Ice and Snow thickness 
     31#endif 
    2932   USE cpl_oasis3      ! OASIS3 coupling 
    3033   USE geo2ocean       !  
     
    3841   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3942   USE mod_prism_proto ! OASIS3 prism module: PRISM_* variables... 
     43   USE phycst, ONLY : xlsn, rhosn 
    4044   IMPLICIT NONE 
    4145   PRIVATE 
     
    6064   INTEGER, PARAMETER ::   jpr_qsroce = 13            ! Qsr above the ocean 
    6165   INTEGER, PARAMETER ::   jpr_qsrice = 14            ! Qsr above the ice 
    62    INTEGER, PARAMETER ::   jpr_qsrmix =  jpr_qsroce   ! Qsr above ocean+ice 
    63    INTEGER, PARAMETER ::   jpr_qnsoce = 15            ! Qns above the ocean 
    64    INTEGER, PARAMETER ::   jpr_qnsice = 16            ! Qns above the ice 
    65    INTEGER, PARAMETER ::   jpr_qnsmix =  jpr_qnsoce   ! Qns above ocean+ice 
    66    INTEGER, PARAMETER ::   jpr_rain   = 17            ! total liquid precipitation (rain) 
    67    INTEGER, PARAMETER ::   jpr_snow   = 18            ! solid precipitation over the ocean (snow) 
    68    INTEGER, PARAMETER ::   jpr_tevp   = 19            ! total evaporation 
    69    INTEGER, PARAMETER ::   jpr_ievp   = 20            ! solid evaporation (sublimation) 
    70    INTEGER, PARAMETER ::   jpr_prsb   = 21            ! total precipitation (liquid + solid) 
    71    INTEGER, PARAMETER ::   jpr_semp   = 22            ! solid freshwater budget (sublimation - snow) 
    72    INTEGER, PARAMETER ::   jpr_oemp   = 23            ! ocean freshwater budget (evap - precip) 
    73    INTEGER, PARAMETER ::   jpr_w10m   = 24            !  
    74    INTEGER, PARAMETER ::   jpr_dqnsdt = 25            !  
    75    INTEGER, PARAMETER ::   jpr_rnf    = 26            !  
    76    INTEGER, PARAMETER ::   jpr_cal    = 27            !  
    77    INTEGER, PARAMETER ::   jprcv      = 27            ! total number of fields recieved 
     66   INTEGER, PARAMETER ::   jpr_qsrmix = 15  
     67   INTEGER, PARAMETER ::   jpr_qnsoce = 16            ! Qns above the ocean 
     68   INTEGER, PARAMETER ::   jpr_qnsice = 17            ! Qns above the ice 
     69   INTEGER, PARAMETER ::   jpr_qnsmix = 18 
     70   INTEGER, PARAMETER ::   jpr_rain   = 19            ! total liquid precipitation (rain) 
     71   INTEGER, PARAMETER ::   jpr_snow   = 20            ! solid precipitation over the ocean (snow) 
     72   INTEGER, PARAMETER ::   jpr_tevp   = 21            ! total evaporation 
     73   INTEGER, PARAMETER ::   jpr_ievp   = 22            ! solid evaporation (sublimation) 
     74   INTEGER, PARAMETER ::   jpr_prsb   = 23            ! sublimation - liquid precipitation - solid precipitation 
     75   INTEGER, PARAMETER ::   jpr_semp   = 24            ! solid freshwater budget (sublimation - snow) 
     76   INTEGER, PARAMETER ::   jpr_oemp   = 25            ! ocean freshwater budget (evap - precip) 
     77   INTEGER, PARAMETER ::   jpr_w10m   = 26            !  
     78   INTEGER, PARAMETER ::   jpr_dqnsdt = 27            !  
     79   INTEGER, PARAMETER ::   jpr_rnf    = 28            !  
     80   INTEGER, PARAMETER ::   jpr_cal    = 29            !  
     81   INTEGER, PARAMETER ::   jprcv      = 29            ! total number of fields recieved 
    7882    
    7983   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     
    130134   !!---------------------------------------------------------------------- 
    131135   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)  
    132    !! $Id:$ 
     136   !! $Id$ 
    133137   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    134138   !!---------------------------------------------------------------------- 
     
    298302      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation) 
    299303      srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation 
    300       srcv(jpr_prsb)%clname = 'OPre-Sub'      ! liquid precipitation + solid precipitation - sublimation 
     304      srcv(jpr_prsb)%clname = 'OPre-Sub'      ! sublimation - liquid precipitation - solid precipitation  
    301305      srcv(jpr_semp)%clname = 'OISub-Sn'      ! ice solid water budget = sublimation - solid precipitation 
    302306      srcv(jpr_oemp)%clname = 'OOEva-Pr'      ! ocean water budget = ocean Evap - ocean precip 
     
    304308      CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
    305309      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    306       CASE( 'oce and ice'   )   ;   srcv( (/          jpr_prsb, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
     310      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_prsb, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    307311      CASE( 'mixed oce-ice' )   ;   srcv( (/jpr_rain,           jpr_semp, jpr_tevp/) )%laction = .TRUE.  
    308312      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 
     
    421425      ssnd(jps_ocz1)%clname = 'O_OCurz1'   ;   ssnd(jps_ivz1)%clname = 'O_IVelz1' 
    422426      ! 
    423       ssnd(jps_ocx1:jps_ivz2)%nsgn = -1    ! vectors: change of the sign at the north fold 
     427      ssnd(jps_ocx1:jps_ivz1)%nsgn = -1    ! vectors: change of the sign at the north fold 
    424428 
    425429      IF( cn_snd_crt(4) /= 'T' )   CALL ctl_stop( 'cn_snd_crt(4) must be equal to T' ) 
    426       ssnd(jps_ocx1:jps_ivz2)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
    427       ssnd(jps_ocx1:jps_ocz1)%laction = .TRUE.   ! oce components on 1 grid  
    428       ssnd(jps_ivx1:jps_ivz1)%laction = .TRUE.   ! ice components on 1 grid  
    429        
    430       IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   &                        ! 3rd component not used 
    431          &     srcv( (/jps_otz1, jps_otz2, jps_itz1, jps_itz2/) )%laction = .FALSE.  
    432       ! 
    433       IF( TRIM( cn_snd_crt(1) ) /= 'oce only' .OR. 'oce and ice' )   &      ! ice components not used 
    434          &     srcv(jps_itx1:jps_itz2)%laction = FALSE. 
    435  
     430      ssnd(jps_ocx1:jps_ivz1)%clgrid  = 'T'      ! all oce and ice components on the same unique grid 
     431 
     432      ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE.   ! default: all are send 
     433      IF( TRIM( cn_snd_crt(2) ) == 'spherical' )   ssnd( (/jps_ocz1, jps_ivz1/) )%laction = .FALSE.  
    436434      SELECT CASE( TRIM( cn_snd_crt(1) ) ) 
    437       CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz2)%laction = .FALSE. 
    438       CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz2)%laction = .FALSE. 
     435      CASE( 'none'                 )   ;   ssnd(jps_ocx1:jps_ivz1)%laction = .FALSE. 
     436      CASE( 'oce only'             )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    439437      CASE( 'weighted oce and ice' )   !   nothing to do 
    440       CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz2)%laction = .FALSE. 
     438      CASE( 'mixed oce-ice'        )   ;   ssnd(jps_ivx1:jps_ivz1)%laction = .FALSE. 
    441439      END SELECT 
    442440 
     
    444442      !   initialisation of the coupler  ! 
    445443      ! ================================ ! 
    446       CALL cpl_prism_define             
     444 
     445      CALL cpl_prism_define(jprcv, jpsnd)             
    447446      ! 
    448447   END SUBROUTINE sbc_cpl_init 
     
    498497      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
    499498      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    500       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace  
     499      REAL(wp) ::   zcoef                  ! temporary scalar 
     500      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace  
    501501      !!---------------------------------------------------------------------- 
    502502 
     
    570570      ENDIF 
    571571      !                                                      ! ========================= ! 
    572       IF( k_ice <= 1 ) THEN                                 !  heat & freshwater fluxes ! (Ocean only case) 
     572      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case) 
    573573         !                                                   ! ========================= ! 
    574574         ! 
     
    576576         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce) 
    577577         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)         
     578         !   energy for melting solid precipitation over free ocean 
     579         zcoef = xlsn / rhosn 
     580         qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * zcoef 
    578581         !                                                       ! solar flux over the ocean          (qsr) 
    579582         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce)  
     
    614617 
    615618         !                                                       ! 10 m wind speed 
    616          IF( srcv(jpr_w10m)%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m) 
     619!!AC         IF( srcv(jpr_w10m)%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m) 
    617620!!gm ---> blinder dans tke  si cn_rcv_w10m == 'none' 
    618621         ! 
     
    660663      INTEGER ::   ji, jj                          ! dummy loop indices 
    661664      INTEGER ::   itx                             ! index of taux over ice 
    662       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace 
     665      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace 
    663666      !!---------------------------------------------------------------------- 
    664667 
     
    803806      &                                pqns_tot, pqns_ice,         & 
    804807      &                                pqsr_tot, pqsr_ice,         & 
    805       &                                pemp_tot, pemp_ice, psprecip ) 
     808      &                                pemp_tot, pemp_ice, pdqns_ice, psprecip ) 
    806809      !!---------------------------------------------------------------------- 
    807810      !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  *** 
     
    843846      !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
    844847      !!                   pemp_ice            ice sublimation - solid precipitation over the ice 
    845       !!                   sprecip             solid precipitation over the ocean    
     848      !!                   pdqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
     849      !!                   sprecip             solid precipitation over the ocean   
    846850      !!                   wind10m             10m wind module 
    847851      !!---------------------------------------------------------------------- 
     
    857861      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s] 
    858862      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   psprecip   ! solid precipitation          [Kg/m2/s] 
     863      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pdqns_ice  
    859864     !! 
    860865      INTEGER ::   ji, jj           ! dummy loop indices 
    861866      INTEGER ::   isec, info       ! temporary integer 
    862867      REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
    863       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, ztx   ! 2D workspace 
    864868      !!---------------------------------------------------------------------- 
    865869      ! 
     
    877881         psprecip(:,:) = frcv(:,:,jpr_snow) 
    878882      CASE( 'oce and ice'   )   ! received fields: jpr_prsb, jpr_semp, jpr_oemp 
    879          pemp_tot(:,:) = p_frld(:,:) * frcv(:,:,jpr_oemp) + (1.- p_frld(:,:)) * frcv(:,:,jpr_semp) !!sm: rain over ice is missing?? 
     883         pemp_tot(:,:) = p_frld(:,:) * frcv(:,:,jpr_oemp) + (1.- p_frld(:,:)) * frcv(:,:,jpr_prsb)  
    880884         pemp_ice(:,:) = frcv(:,:,jpr_semp) 
    881          psprecip(:,:) = frcv(:,:,jpr_semp)                            !!gm here error due to sublimation 
     885         psprecip(:,:) = - frcv(:,:,jpr_semp) + frcv(:,:,jpr_ievp) 
    882886      CASE( 'mixed oce-ice' )   ! received fields: jpr_rain, jpr_semp, jpr_tevp 
    883887         pemp_tot(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_rain) + frcv(:,:,jpr_semp)       !!gm here sublimation error  ??? 
     
    924928      !   energy for melting solid precipitation over free ocean 
    925929      zcoef = xlsn / rhosn 
    926       pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,:) * psprecip(:,:) * zcoef   
     930      pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,:) * psprecip(:,:) * zcoef 
    927931!!gm 
    928932!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     
    945949         pqsr_tot(:,:) = frcv(:,:,jpr_qsrmix) 
    946950!!gm  cpl_albedo ???? kezako ?????   je pige pas grand chose ici.... 
    947          pqsr_ice(:,:) = qsr_mix(:,:) * ( 1.- palbi(:,:) )   & 
     951         pqsr_ice(:,:) = frcv(:,:,jpr_qsrmix) * ( 1.- palbi(:,:) )   & 
    948952            &          / (  1.- ( cpl_ocean_albedo(ji,jj) * ( 1.- p_frld(ji,jj) )   & 
    949953            &                   + palbi           (ji,jj) *       p_frld(ji,jj)   )  ) 
     
    951955 
    952956 
     957      SELECT CASE( TRIM( cn_rcv_dqnsdt ) ) 
     958      CASE ('coupled') 
     959          pdqns_ice(:,:) = frcv(:,:,jpr_dqnsdt) 
     960      END SELECT 
     961 
     962 
    953963      !                                                      ! ========================= ! 
    954964      !                                                      !      10 m wind speed      !   (wind10m) 
    955965      !                                                      ! ========================= ! 
    956966      ! 
    957       IF( srcv(jpr_w10m  )%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m) 
     967!!AC      IF( srcv(jpr_w10m  )%laction )   wind10m(:,:) = frcv(:,:,jpr_w10m) 
    958968!!gm ---> blinder dans tke  si cn_rcv_w10m == 'none' 
    959969      ! 
    960    END SUBROUTINE sbc_cpl_ice_flx_rcv 
     970   END SUBROUTINE sbc_cpl_ice_flx 
    961971    
    962972    
     
    10001010      !                                                      ! ------------------------- ! 
    10011011      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1002          ztmp(:,:) = alb_ice(:,:) * fr_i(:,:) 
    1003          CALL cpl_prism_snd( jps_albice, isec, ztmp, info ) 
     1012         ztmp1(:,:) = alb_ice(:,:) * fr_i(:,:) 
     1013         CALL cpl_prism_snd( jps_albice, isec, ztmp1, info ) 
    10041014      ENDIF 
    10051015      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    1006          ztmp(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:) * fr_i(:,:) 
    1007          CALL cpl_prism_snd( jps_albmix, isec, ztmp, info ) 
     1016         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) + alb_ice(:,:) * fr_i(:,:) 
     1017         CALL cpl_prism_snd( jps_albmix, isec, ztmp1, info ) 
    10081018      ENDIF 
    10091019      !                                                      ! ------------------------- ! 
    10101020      !                                                      !  Ice fraction & Thickness !  
    10111021      !                                                      ! ------------------------- ! 
    1012       IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                 , info ) 
    1013       IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hice(:,:) * fr_i(:,:), info ) 
    1014       IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnw(:,:) * fr_i(:,:), info ) 
     1022      IF( ssnd(jps_fice)%laction )   CALL cpl_prism_snd( jps_fice, isec, fr_i                  , info ) 
     1023      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, hicif(:,:) * fr_i(:,:), info ) 
     1024      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, hsnif(:,:) * fr_i(:,:), info ) 
    10151025      ! 
    10161026      !                                                      ! ------------------------- ! 
     
    10261036            END DO 
    10271037         CASE( 'weighted oce and ice' )    
    1028             IF( cice_grid = 'C' ) THEN      ! 'C'-grid ice velocity 
     1038            IF( cice_grid == 'C' ) THEN      ! 'C'-grid ice velocity 
    10291039               DO jj = 2, jpjm1 
    10301040                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1031                      zotx1(ji,jj) = 0.5 * ( un       (ji,jj,1) + un       (ji-1,jj  ,1) ) * zfr_l(:,: 
    1032                      zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(:,:) 
    1033                      zitx1(ji,jj) = 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(:,:) 
    1034                      zity1(ji,jj) = 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(:,:) 
     1041                     zotx1(ji,jj) = 0.5 * ( un       (ji,jj,1) + un       (ji-1,jj  ,1) ) * zfr_l(ji,jj 
     1042                     zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(ji,jj) 
     1043                     zitx1(ji,jj) = 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(ji,jj) 
     1044                     zity1(ji,jj) = 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(ji,jj) 
    10351045                  END DO 
    10361046               END DO 
     
    10381048               DO jj = 2, jpjm1 
    10391049                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1040                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)          + un(ji-1,jj-1,1)    ) * zfr_l(:,: 
    1041                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(:,: 
     1050                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)          + un(ji-1,jj-1,1)    ) * zfr_l(ji,jj 
     1051                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(ji,jj 
    10421052                     zitx1(ji,jj) = 0.25 * ( utaui_ice(ji+1,jj+1) + utaui_ice(ji,jj+1)   & 
    1043                         &                  + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) * fr_i(:,:) 
     1053                        &                  + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) * fr_i(ji,jj) 
    10441054                     zity1(ji,jj) = 0.25 * ( vtaui_ice(ji+1,jj+1) + vtaui_ice(ji,jj+1)   & 
    1045                         &                  + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) * fr_i(:,:) 
     1055                        &                  + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) * fr_i(ji,jj) 
    10461056                  END DO 
    10471057               END DO 
     
    10491059            CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. ) 
    10501060         CASE( 'mixed oce-ice'        ) 
    1051             IF( cice_grid = 'C' ) THEN      ! 'C'-grid ice velocity 
     1061            IF( cice_grid == 'C' ) THEN      ! 'C'-grid ice velocity 
    10521062               DO jj = 2, jpjm1 
    1053                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    1054                      zotx1(ji,jj) = 0.5 * ( un       (ji,jj,1) + un       (ji-1,jj  ,1) ) * zfr_l(:,:) 
    1055                      &            + 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(:,:) 
    1056                      zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(:,:) 
    1057                      &            + 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(:,:) 
    1058                   END DO 
     1063                 DO ji = fs_2, fs_jpim1   ! vector opt. 
     1064                   zotx1(ji,jj) = 0.5 * ( un       (ji,jj,1) + un       (ji-1,jj  ,1) ) * zfr_l(ji,jj) & 
     1065                      + 0.5 * ( utaui_ice(ji,jj)   + utaui_ice(ji-1,jj  )   ) *  fr_i(ji,jj) 
     1066                   zoty1(ji,jj) = 0.5 * ( vn       (ji,jj,1) + un       (ji  ,jj-1,1) ) * zfr_l(ji,jj) & 
     1067                      + 0.5 * ( vtaui_ice(ji,jj)   + vtaui_ice(ji  ,jj-1)   ) *  fr_i(ji,jj) 
     1068                 END DO 
    10591069               END DO 
    10601070            ELSE                            ! 'B'-grid ice velocity 
    10611071               DO jj = 2, jpjm1 
    10621072                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    1063                      zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)          + un(ji-1,jj-1,1)    ) * zfr_l(:,:)     
    1064                      &            + 0.25 * ( utaui_ice(ji+1,jj+1) + utaui_ice(ji,jj+1)   & 
    1065                         &                  + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) *  fr_i(:,:) 
    1066                      zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(:,:)  
    1067                      &            + 0.25 * ( vtaui_ice(ji+1,jj+1) + vtaui_ice(ji,jj+1)   & 
    1068                         &                  + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) *  fr_i(:,:) 
     1073                     zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)          + un(ji-1,jj-1,1)    ) * zfr_l(ji,jj) &    
     1074                       + 0.25 * ( utaui_ice(ji+1,jj+1) + utaui_ice(ji,jj+1)   & 
     1075                                     + utaui_ice(ji+1,jj  ) + utaui_ice(ji,jj  ) ) *  fr_i(ji,jj) 
     1076                     zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)          + un(ji  ,jj-1,1)    ) * zfr_l(ji,jj) &  
     1077                           + 0.25 * ( vtaui_ice(ji+1,jj+1) + vtaui_ice(ji,jj+1)   & 
     1078                              + vtaui_ice(ji+1,jj  ) + vtaui_ice(ji,jj  ) ) *  fr_i(ji,jj) 
    10691079                  END DO 
    10701080               END DO 
     
    10881098         ENDIF 
    10891099         ! 
    1090          !!gm  Eric : Arnaud, je te laisse coder oce2geo !      
    10911100         ! spherical coordinates to cartesian -> 2 components to 3 components 
    10921101         IF( TRIM( cn_snd_crt(2) ) == 'cartesian' ) THEN 
    10931102            ztmp1(:,:) = zotx1(:,:)                     ! ocean currents 
    10941103            ztmp2(:,:) = zoty1(:,:) 
    1095             CALL oce2geo ( ztmp1, ztmp2, 't', glamt, gphit, zotx1, zoty1, zotz1 ) 
     1104            CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 ) 
    10961105            ! 
    10971106            IF( ssnd(jps_ivx1)%laction ) THEN           ! ice velocities 
    10981107               ztmp1(:,:) = zitx1(:,:) 
    10991108               ztmp1(:,:) = zity1(:,:) 
    1100                CALL oce2geo ( ztmp1, ztmp2, 't', glamt, gphit, zitx1, zity1, zitz1 ) 
     1109               CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 ) 
    11011110            ENDIF 
    11021111         ENDIF 
     
    11121121      ENDIF 
    11131122   ! 
    1114 END SUBROUTINE sbc_cpl_snd 
     1123   END SUBROUTINE sbc_cpl_snd 
    11151124    
    11161125#else 
  • trunk/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r1218 r1226  
    193193      &                                                             qns_tot, qns_ice,   & 
    194194      &                                                             qsr_tot, qsr_ice,   & 
    195       &                                                             emp_tot, emp_ice, sprecip ) 
     195      &                                                             emp_tot, emp_ice, dqns_ice, sprecip ) 
    196196#endif 
    197197                                        CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
  • trunk/NEMO/OPA_SRC/SBC/sbcmod.F90

    r1218 r1226  
    2828   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model 
    2929   USE sbccpl          ! surface boundary condition: coupled florulation 
     30   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    3031   USE sbcssr          ! surface boundary condition: sea surface restoring 
    3132   USE sbcrnf          ! surface boundary condition: runoffs 
     
    130131         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    131132      ! 
    132       IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core ) )   & 
    133          &   CALL ctl_stop( 'sea-ice model requires a bulk formulation' ) 
     133      IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   & 
     134         &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' ) 
    134135       
    135136      ! Choice of the Surface Boudary Condition (set nsbc) 
     
    201202      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation 
    202203      CASE( -1 )                                 
    203                        CALL sbc_ana     ( kt )                     ! ESOPA, test ALL the formulations 
    204                        CALL sbc_gyre    ( kt )                     ! 
    205                        CALL sbc_flx     ( kt )                     ! 
    206                        CALL sbc_blk_clio( kt )                     ! 
    207                        CALL sbc_blk_core( kt )                     ! 
    208                        CALL sbc_cpl_rcv ( kt,  nn_fsbc, nn_ice )   ! 
     204                       CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
     205                       CALL sbc_gyre    ( kt )                    ! 
     206                       CALL sbc_flx     ( kt )                    ! 
     207                       CALL sbc_blk_clio( kt )                    ! 
     208                       CALL sbc_blk_core( kt )                    ! 
     209                       CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! 
    209210      END SELECT 
    210211 
  • trunk/NEMO/OPA_SRC/geo2ocean.F90

    r1218 r1226  
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)  
    41    !! $Id:$  
     41   !! $Id$  
    4242   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
     
    311311 
    312312      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    313       CALL lbc_lnk ( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
    314       CALL lbc_lnk ( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
    315       CALL lbc_lnk ( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
    316       CALL lbc_lnk ( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
     313      CALL lbc_lnk( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
     314      CALL lbc_lnk( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
     315      CALL lbc_lnk( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
     316      CALL lbc_lnk( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
    317317 
    318318   END SUBROUTINE angle 
     
    350350 
    351351      SELECT CASE( cgrid) 
    352          CASE ( 't' )    
     352         CASE ( 'T' )    
    353353            ig = 1 
    354354            IF( .NOT. linit(ig) ) THEN  
    355                zsinlon (:,:,ig) = SIN (rad * glamt) 
    356                zcoslon (:,:,ig) = COS (rad * glamt) 
    357                zsinlat (:,:,ig) = SIN (rad * gphit) 
    358                zcoslat (:,:,ig) = COS (rad * gphit) 
    359                linit (ig) = .TRUE. 
    360             ENDIF 
    361          CASE ( 'u' )    
     355               zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
     356               zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
     357               zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
     358               zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     359               linit(ig) = .TRUE. 
     360            ENDIF 
     361         CASE ( 'U' )    
    362362            ig = 2 
    363363            IF( .NOT. linit(ig) ) THEN  
    364                zsinlon (:,:,ig) = SIN (rad * glamu) 
    365                zcoslon (:,:,ig) = COS (rad * glamu) 
    366                zsinlat (:,:,ig) = SIN (rad * gphiu) 
    367                zcoslat (:,:,ig) = COS (rad * gphiu) 
    368                linit (ig) = .TRUE. 
    369             ENDIF 
    370          CASE ( 'v' )    
     364               zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
     365               zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
     366               zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     367               zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     368               linit(ig) = .TRUE. 
     369            ENDIF 
     370         CASE ( 'V' )    
    371371            ig = 3 
    372372            IF( .NOT. linit(ig) ) THEN  
    373                zsinlon (:,:,ig) = SIN (rad * glamv) 
    374                zcoslon (:,:,ig) = COS (rad * glamv) 
    375                zsinlat (:,:,ig) = SIN (rad * gphiv) 
    376                zcoslat (:,:,ig) = COS (rad * gphiv) 
    377                linit (ig) = .TRUE. 
    378             ENDIF 
    379          CASE ( 'f' )    
     373               zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
     374               zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
     375               zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     376               zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     377               linit(ig) = .TRUE. 
     378            ENDIF 
     379         CASE ( 'F' )    
    380380            ig = 4 
    381381            IF( .NOT. linit(ig) ) THEN  
    382                zsinlon (:,:,ig) = SIN (rad * glamf) 
    383                zcoslon (:,:,ig) = COS (rad * glamf) 
    384                zsinlat (:,:,ig) = SIN (rad * gphif) 
    385                zcoslat (:,:,ig) = COS (rad * gphif) 
    386                linit (ig) = .TRUE. 
     382               zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
     383               zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
     384               zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
     385               zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     386               linit(ig) = .TRUE. 
    387387            ENDIF 
    388388         CASE default    
     
    391391      END SELECT 
    392392       
    393       pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy 
    394       ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx    & 
    395             - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    & 
    396             + zcoslat (:,:,ig) * pzz 
    397 !!$   ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    & 
    398 !!$         + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    & 
    399 !!$         + zsinlat (:,:,ig) * pzz 
     393      pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 
     394      ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx    & 
     395            - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy    & 
     396            + zcoslat(:,:,ig) * pzz 
     397!!$   ptv =   zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx    & 
     398!!$         + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy    & 
     399!!$         + zsinlat(:,:,ig) * pzz 
    400400      ! 
    401401   END SUBROUTINE geo2oce 
    402402 
    403403   SUBROUTINE oce2geo ( pte, ptn, cgrid,     & 
    404                         plon, plat, pxx , pyy , pzz ) 
     404                        pxx , pyy , pzz ) 
    405405      !!---------------------------------------------------------------------- 
    406406      !!                    ***  ROUTINE oce2geo  *** 
     
    415415      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn 
    416416      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid 
    417       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  plon, plat 
    418417      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz 
    419418      !! 
     
    426425      !!---------------------------------------------------------------------- 
    427426 
    428       WRITE(ctmp1,*) 'oce2geo : Arnaud, au boulot ' 
    429       CALL ctl_stop( ctmp1 ) 
    430  
    431427      SELECT CASE( cgrid) 
    432          CASE ( 't' ) ;; ig = 1 
    433          CASE ( 'u' ) ;; ig = 2 
    434          CASE ( 'v' ) ;; ig = 3 
    435          CASE ( 'f' ) ;; ig = 4 
    436          CASE default 
    437             WRITE(ctmp1,*) 'oce2geo : bad grid argument : ', cgrid 
     428         CASE ( 'T' )    
     429            ig = 1 
     430            IF( .NOT. linit(ig) ) THEN  
     431               zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
     432               zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
     433               zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
     434               zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     435               linit(ig) = .TRUE. 
     436            ENDIF 
     437         CASE ( 'U' )    
     438            ig = 2 
     439            IF( .NOT. linit(ig) ) THEN  
     440               zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
     441               zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
     442               zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     443               zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     444               linit(ig) = .TRUE. 
     445            ENDIF 
     446         CASE ( 'V' )    
     447            ig = 3 
     448            IF( .NOT. linit(ig) ) THEN  
     449               zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
     450               zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
     451               zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     452               zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     453               linit(ig) = .TRUE. 
     454            ENDIF 
     455         CASE ( 'F' )    
     456            ig = 4 
     457            IF( .NOT. linit(ig) ) THEN  
     458               zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
     459               zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
     460               zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
     461               zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     462               linit(ig) = .TRUE. 
     463            ENDIF 
     464         CASE default    
     465            WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 
    438466            CALL ctl_stop( ctmp1 ) 
    439        END SELECT 
    440        pxx(:,:) = 0. ; pyy(:,:) = 0. ; pzz(:,:) = 0. ! stupid definition to avoid warning message when compiling... 
     467      END SELECT 
     468 
     469       pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn  
     470       pyy =   zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 
     471       pzz =   zcoslat(:,:,ig) * ptn 
     472 
    441473       
    442474   END SUBROUTINE oce2geo 
  • trunk/NEMO/OPA_SRC/opa.F90

    r1218 r1226  
    172172      !! 
    173173      !!---------------------------------------------------------------------- 
    174 #if defined key_coupled 
    175       INTEGER ::   itro, istp0        ! ??? 
    176 #endif 
    177174#if defined key_oasis3 || defined key_oasis4 
    178175      INTEGER :: localComm 
     
    289286#endif 
    290287 
    291 #if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4 
    292       itro  = nitend - nit000 + 1           ! Coupled 
    293       istp0 = NINT( rdt ) 
    294       CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange 
    295 #endif 
    296  
    297 #if defined key_oasis3 || defined key_oasis4 
    298       CALL cpl_prism_define 
    299 #endif 
    300  
    301288      CALL dia_ptr_init                     ! Poleward TRansports initialization 
    302289 
Note: See TracChangeset for help on using the changeset viewer.