Changeset 5299
- Timestamp:
- 2015-05-27T18:17:08+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO
- Files:
-
- 11 edited
-
LIM_SRC_3/limthd.F90 (modified) (1 diff)
-
OPA_SRC/IOM/iom.F90 (modified) (4 diffs)
-
OPA_SRC/IOM/restart.F90 (modified) (6 diffs)
-
OPA_SRC/SBC/cpl_oasis3.F90 (modified) (1 diff)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (23 diffs)
-
OPA_SRC/SBC/sbcmod.F90 (modified) (3 diffs)
-
OPA_SRC/SBC/sbcssm.F90 (modified) (6 diffs)
-
OPA_SRC/TRA/traqsr.F90 (modified) (4 diffs)
-
SAS_SRC/daymod.F90 (modified) (1 diff)
-
SAS_SRC/nemogcm.F90 (modified) (15 diffs)
-
SAS_SRC/step.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5220 r5299 28 28 USE thd_ice ! LIM thermodynamic sea-ice variables 29 29 USE dom_ice ! LIM sea-ice domain 30 USE domvvl ! domain: variable volume level31 30 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 32 31 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5147 r5299 121 121 CALL set_scalar 122 122 123 IF( TRIM(cdname) == "nemo") THEN123 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 124 124 CALL set_grid( "T", glamt, gphit ) 125 125 CALL set_grid( "U", glamu, gphiu ) … … 128 128 ENDIF 129 129 130 IF( TRIM(cdname) == "nemo_crs" ) THEN130 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 131 131 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 132 132 ! … … 1200 1200 CALL iom_swap( cdname ) ! swap to cdname context 1201 1201 CALL xios_update_calendar(kt) 1202 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1202 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1203 1203 ! 1204 1204 END SUBROUTINE iom_setkt … … 1210 1210 CALL iom_swap( cdname ) ! swap to cdname context 1211 1211 CALL xios_context_finalize() ! finalize the context 1212 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1212 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1213 1213 ENDIF 1214 1214 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4990 r5299 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 26 USE sbc_ice, ONLY : lk_lim3 27 USE sbc_oce, ONLY : nn_components, jp_iam_opa 27 28 28 29 IMPLICIT NONE … … 121 122 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 123 ! 123 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )124 IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 124 125 ! 125 126 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 134 135 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 135 136 #endif 136 IF( lk_lim3 ) THEN137 IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN 137 138 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif 138 139 ENDIF … … 214 215 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 215 216 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 216 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 217 ! EM Attention Ceci doit etre reimplemente correctement 218 !EM IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 219 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 217 220 ELSE 218 221 neuler = 0 … … 257 260 ENDIF 258 261 259 IF( lk_lim3.AND. .NOT. lk_vvl ) THEN262 IF( ( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) .AND. .NOT. lk_vvl ) THEN 260 263 DO jk = 1, jpk 261 264 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) … … 265 268 ENDIF 266 269 ! 267 IF( lk_lim3 ) THEN 270 !EM Idem 271 !EM IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN 268 272 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 269 ENDIF273 !EM ENDIF 270 274 ! 271 275 END SUBROUTINE rst_read -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r5220 r5299 433 433 ! 434 434 DO ji = 1, nsnd 435 DO jm = 1, ncplmodel 436 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 437 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) id = ssnd(ji)%nid(1,jm) 438 ENDIF 439 ENDDO 435 IF (ssnd(ji)%laction ) THEN 436 DO jm = 1, ncplmodel 437 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 438 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 439 id = ssnd(ji)%nid(1,jm) 440 ENDIF 441 ENDIF 442 ENDDO 443 ENDIF 440 444 ENDDO 441 445 DO ji = 1, nrcv 442 DO jm = 1, ncplmodel 443 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 444 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) id = srcv(ji)%nid(1,jm) 445 ENDIF 446 ENDDO 446 IF (srcv(ji)%laction ) THEN 447 DO jm = 1, ncplmodel 448 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 449 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 450 id = srcv(ji)%nid(1,jm) 451 ENDIF 452 ENDIF 453 ENDDO 454 ENDIF 447 455 ENDDO 448 456 ! -
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 ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5220 r5299 309 309 310 310 311 IF( nn_components /= jp_iam_sas ) THEN 312 313 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 314 ELSE 315 ! 316 ! sas currently uses surface temperature and salinity in tsn array 317 ! for initialisation 318 ! and ub, vb arrays in ice dynamics 319 ! so allocate enough of arrays to use 320 ! 321 ierr3 = 0 322 jpm = MAX(jp_tem, jp_sal) 323 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 ) 324 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 ) 325 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 ) 326 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 ) 327 ierr = ierr0 + ierr1 + ierr2 + ierr3 328 IF( ierr > 0 ) THEN 329 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays') 330 ENDIF 331 332 ENDIF 311 IF( nn_components /= jp_iam_sas ) & 312 & CALL sbc_ssm_init ! Sea-surface mean fields initialisation 333 313 ! 334 314 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation … … 393 373 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 394 374 CASE( jp_core ) 395 396 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OASIS-coupled ice375 IF( nn_components == jp_iam_sas ) & 376 & CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA 397 377 CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 398 378 ! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m) … … 400 380 ! 401 381 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 402 CASE( jp_none ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OASIS-coupled ice403 ! fluxes qsr, qns, emp, sfx,utau, vtau404 ! sss_m, ssu_m, ssv_m)382 CASE( jp_none ) 383 IF( nn_components == jp_iam_opa ) & 384 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 405 385 CASE( jp_esopa ) 406 386 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5223 r5299 58 58 REAL(wp) :: zcoef, zf_sbc ! local scalar 59 59 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 60 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb,zdep61 60 !!--------------------------------------------------------------------- 62 61 63 62 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 64 IF( nn_components == jp_iam_opa ) THEN 65 DO jj = 1, jpj 66 DO ji = 1, jpi 67 zts(ji,jj,jp_tem) = tsb(ji,jj,mikt(ji,jj),jp_tem) 68 zts(ji,jj,jp_sal) = tsb(ji,jj,mikt(ji,jj),jp_sal) 69 END DO 63 DO jj = 1, jpj 64 DO ji = 1, jpi 65 zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 66 zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) 70 67 END DO 71 ELSE 72 DO jj = 1, jpj 73 DO ji = 1, jpi 74 zts(ji,jj,jp_tem) = tsb(ji,jj,mikt(ji,jj),jp_tem) 75 zts(ji,jj,jp_sal) = tsb(ji,jj,mikt(ji,jj),jp_sal) 76 END DO 77 END DO 78 ENDIF 79 zub(:,:) = ub (:,:,1 ) 80 zvb(:,:) = vb (:,:,1 ) 81 ! 82 IF( lk_vvl ) THEN 83 zdep(:,:) = fse3t_n(:,:,1) 84 ENDIF 85 ! ! ---------------------------------------- ! 68 END DO 69 ! 86 70 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 87 71 ! ! ---------------------------------------- ! 88 ssu_m(:,:) = zub(:,:)89 ssv_m(:,:) = zvb(:,:)72 ssu_m(:,:) = ub(:,:,1) 73 ssv_m(:,:) = vb(:,:,1) 90 74 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 91 75 ELSE ; sst_m(:,:) = zts(:,:,jp_tem) … … 93 77 sss_m(:,:) = zts(:,:,jp_sal) 94 78 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 95 IF( nn_components == jp_iam_opa ) THEN 96 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 97 ELSE ; ssh_m(:,:) = sshb(:,:) 98 ENDIF 99 ELSE 100 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 101 ELSE ; ssh_m(:,:) = sshn(:,:) 102 ENDIF 103 ENDIF 104 ! 105 IF( lk_vvl ) fse3t_m(:,:) = zdep(:,:) 79 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 80 ELSE ; ssh_m(:,:) = sshn(:,:) 81 ENDIF 82 ! 83 IF( lk_vvl ) fse3t_m(:,:) = fse3t_n(:,:,1) 106 84 ! 107 85 ELSE … … 112 90 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values' 113 91 zcoef = REAL( nn_fsbc - 1, wp ) 114 ssu_m(:,:) = zcoef * zub(:,:)115 ssv_m(:,:) = zcoef * zvb(:,:)92 ssu_m(:,:) = zcoef * ub(:,:,1) 93 ssv_m(:,:) = zcoef * vb(:,:,1) 116 94 IF( ln_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 117 95 ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem) … … 119 97 sss_m(:,:) = zcoef * zts(:,:,jp_sal) 120 98 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 121 IF( nn_components == jp_iam_opa ) THEN 122 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 123 ELSE ; ssh_m(:,:) = zcoef * sshb(:,:) 124 ENDIF 125 ELSE 126 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 127 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 128 ENDIF 99 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 100 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 129 101 ENDIF 130 102 ! 131 IF( lk_vvl ) fse3t_m(:,:) = zcoef * zdep(:,:)103 IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_n(:,:,1) 132 104 ! ! ---------------------------------------- ! 133 105 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! … … 143 115 ! ! Cumulate at each time step ! 144 116 ! ! ---------------------------------------- ! 145 ssu_m(:,:) = ssu_m(:,:) + zub(:,:)146 ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)117 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 118 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 147 119 IF( ln_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 148 120 ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) … … 150 122 sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 151 123 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 152 IF( nn_components == jp_iam_opa ) THEN 153 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 154 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) 155 ENDIF 156 ELSE 157 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 158 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) 159 ENDIF 160 ENDIF 161 ! 162 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 124 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 125 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 126 ENDIF 127 ! 128 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 163 129 164 130 ! ! ---------------------------------------- ! -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4990 r5299 233 233 END DO 234 234 ! clem: store attenuation coefficient of the first ocean level 235 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN235 IF ( ln_qsr_ice ) THEN 236 236 DO jj = 1, jpj 237 237 DO ji = 1, jpi … … 256 256 END DO 257 257 ! clem: store attenuation coefficient of the first ocean level 258 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN258 IF ( ln_qsr_ice ) THEN 259 259 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 260 ENDIF … … 279 279 END DO 280 280 ! clem: store attenuation coefficient of the first ocean level 281 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN281 IF ( ln_qsr_ice ) THEN 282 282 DO jj = 1, jpj 283 283 DO ji = 1, jpi … … 298 298 END DO 299 299 ! clem: store attenuation coefficient of the first ocean level 300 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN300 IF ( ln_qsr_ice ) THEN 301 301 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 302 302 ENDIF -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r5215 r5299 131 131 132 132 ! control print 133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i 6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', &133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 134 134 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week 135 135 -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5220 r5299 97 97 ! !-----------------------! 98 98 #if defined key_agrif 99 CALL Agrif_Declare_Var ! AGRIF: set the meshes 99 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 100 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 101 # if defined key_top 102 CALL Agrif_Declare_Var_top ! " " " " " TOP 103 # endif 104 # if defined key_lim2 105 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 106 # endif 100 107 #endif 101 108 ! check that all process are still there... If some process have an error, … … 119 126 IF( lk_mpp ) CALL mpp_max( nstop ) 120 127 END DO 128 ! 129 IF( ln_icebergs ) CALL icb_end( nitend ) 130 121 131 ! !------------------------! 122 132 ! !== finalize the run ==! … … 137 147 ! 138 148 CALL nemo_closefile 149 ! 139 150 #if defined key_iomput 140 151 CALL xios_finalize ! end mpp communications with xios … … 160 171 INTEGER :: ilocal_comm ! local integer 161 172 INTEGER :: ios 162 163 173 CHARACTER(len=80), DIMENSION(16) :: cltxt 164 ! !174 ! 165 175 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 166 176 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & … … 169 179 & jpizoom, jpjzoom, jperio, ln_use_jattr 170 180 !!---------------------------------------------------------------------- 181 ! 171 182 cltxt = '' 172 183 cxios_context = 'sas' … … 198 209 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 199 210 211 ! Force values for AGRIF zoom (cf. agrif_user.F90) 212 #if defined key_agrif 213 IF( .NOT. Agrif_Root() ) THEN 214 jpiglo = nbcellsx + 2 + 2*nbghostcells 215 jpjglo = nbcellsy + 2 + 2*nbghostcells 216 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 217 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 218 jpidta = jpiglo 219 jpjdta = jpjglo 220 jpizoom = 1 221 jpjzoom = 1 222 nperio = 0 223 jperio = 0 224 ln_use_jattr = .false. 225 ENDIF 226 #endif 227 ! 200 228 ! !--------------------------------------------! 201 229 ! ! set communicator & select the local node ! … … 253 281 ! than variables 254 282 IF( Agrif_Root() ) THEN 283 #if defined key_nemocice_decomp 284 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 285 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 286 #else 255 287 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 256 #if defined key_nemocice_decomp257 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.258 #else259 288 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 260 289 #endif 290 ENDIF 261 291 jpk = jpkdta ! third dim 262 292 jpim1 = jpi-1 ! inner domain indices … … 264 294 jpkm1 = jpk-1 ! " " 265 295 jpij = jpi*jpj ! jpi x j 266 ENDIF267 296 268 297 IF(lwp) THEN ! open listing units … … 423 452 ENDIF 424 453 ! 454 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 455 & 'f2003 standard. ' , & 456 & 'Compile with key_nosignedzero enabled' ) 457 ! 425 458 END SUBROUTINE nemo_ctl 426 459 … … 464 497 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 465 498 ! 466 INTEGER :: ierr,ierr4 499 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7 500 INTEGER :: jpm 467 501 !!---------------------------------------------------------------------- 468 502 ! … … 471 505 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 472 506 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 473 ierr = ierr + ierr4 507 508 jpm = MAX(jp_tem, jp_sal) 509 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 510 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 ) 511 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 ) 512 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 513 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 514 ALLOCATE( fraqsr_1lev(jpi,jpj), STAT=ierr7 ) 515 516 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 474 517 ! 475 518 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 496 539 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 497 540 !!---------------------------------------------------------------------- 498 541 ! 499 542 ierr = 0 500 543 ! 501 544 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 502 545 ! 503 546 IF( nfact <= 1 ) THEN 504 547 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 542 585 INTEGER, PARAMETER :: ntest = 14 543 586 INTEGER :: ilfax(ntest) 544 587 ! 545 588 ! lfax contains the set of allowed factors. 546 589 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 627 670 !loop over the other north-fold processes to find the processes 628 671 !managing the points belonging to the sxT-dxT range 629 DO jn = jpnij - jpni +1, jpnij630 IF ( njmppt(jn) == njmppmax ) THEN672 673 DO jn = 1, jpni 631 674 !sxT is the first point (in the global domain) of the jn 632 675 !process 633 sxT = n imppt(jn)676 sxT = nfiimpp(jn, jpnj) 634 677 !dxT is the last point (in the global domain) of the jn 635 678 !process 636 dxT = n imppt(jn) + nlcit(jn) - 1679 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 637 680 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 638 681 nsndto = nsndto + 1 639 isendto(nsndto) = jn640 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN682 isendto(nsndto) = jn 683 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 641 684 nsndto = nsndto + 1 642 685 isendto(nsndto) = jn … … 645 688 isendto(nsndto) = jn 646 689 END IF 647 END IF648 690 END DO 691 nfsloop = 1 692 nfeloop = nlci 693 DO jn = 2,jpni-1 694 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 695 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 696 nfsloop = nldi 697 ENDIF 698 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 699 nfeloop = nlei 700 ENDIF 701 ENDIF 702 END DO 703 649 704 ENDIF 650 705 l_north_nogather = .TRUE. -
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/step.F90
r5220 r5299 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE in_out_manager ! I/O manager 19 USE sbc_oce 20 USE sbccpl 19 21 USE iom ! 20 22 USE lbclnk … … 86 88 ! need to keep the same interface 87 89 CALL stp_ctl( kstp, indic ) 90 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 91 ! Coupled mode 92 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 93 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges if OASIS-coupled ice 94 88 95 #if defined key_iomput 89 96 IF( kstp == nitend .OR. indic < 0 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
