Changeset 83
- Timestamp:
- 2004-04-22T15:06:06+02:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/cpl.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/cpl.F90
r15 r83 10 10 !! cpl_init : initialization of coupled mode communication 11 11 !! cpl_read : read the coupled namelist 12 !! cpl_st ep: exchange fields in coupled mode12 !! cpl_stp : exchange fields in coupled mode 13 13 !!---------------------------------------------------------------------- 14 14 !! * Modules used … … 24 24 25 25 !! Routine accessibility 26 PUBLIC cpl_init 27 PUBLIC cpl_st ep ! routine called by step.F9026 PUBLIC cpl_init ! routine called in opa module 27 PUBLIC cpl_stp ! routine called in step module 28 28 !!---------------------------------------------------------------------- 29 29 !! OPA 9.0 , LODYC-IPSL (2003) … … 114 114 115 115 DO jf = 1, nflxc2o 116 ! CALL PIPE_Model_Define( numout,cpl_readflx(jf),jpread,info)116 ! CALL PIPE_Model_Define( numout, cpl_readflx(jf), jpread, info ) 117 117 IF( info /= 0 ) ierror = ierror + 1 118 118 END DO 119 119 DO jf = 1, ntauc2o 120 ! CALL PIPE_Model_Define( numout,cpl_readtau(jf),jpread,info)120 ! CALL PIPE_Model_Define( numout, cpl_readtau(jf), jpread, info ) 121 121 IF( info /= 0 ) ierror = ierror + 1 122 122 END DO … … 129 129 130 130 DO jf = 1, nfldo2c 131 ! CALL PIPE_Model_Define( numout, cpl_writ(jf), jpwrit, info)131 ! CALL PIPE_Model_Define( numout, cpl_writ(jf), jpwrit, info ) 132 132 IF( info /= 0 ) ierror = ierror + 1 133 133 END DO 134 134 135 135 IF( ierror /= 0 ) THEN 136 IF(lwp) WRITE(numout,*) 'Error in pipes definitions'137 IF(lwp) WRITE(numout,*) ' STOP cpl_init'136 IF(lwp) WRITE(numout,*) 137 IF(lwp) WRITE(numout,*) 'cpl_init: end of job due to error in pipes definitions' 138 138 CALL abort 139 139 END IF … … 141 141 IF(lwp) WRITE(numout,*) 142 142 IF(lwp) WRITE(numout,*) 'All pipes have been made' 143 IF(lwp) WRITE(numout,*)144 143 145 144 IF(lwp) WRITE(numout,*) 146 145 IF(lwp) WRITE(numout,*) 'Communication test between OCE and CPL' 147 IF(lwp) WRITE(numout,*)148 146 CALL flush(numout) 149 147 … … 151 149 152 150 IF( ierror /= 0 ) THEN 153 IF(lwp) WRITE(numout,*) 'Error in exchange first informations with Oasis'154 IF(lwp) WRITE(numout,*) ' STOP cpl_init'151 IF(lwp) WRITE(numout,*) 152 IF(lwp) WRITE(numout,*) 'cpl_init: end of job due to error in exchange first informations with Oasis' 155 153 CALL abort 156 154 END IF … … 162 160 IF(lwp) WRITE(numout,*) ' value of oasis timestep is = ',imesso(3) 163 161 IF(lwp) WRITE(numout,*) ' process id for oasis is = ',imesso(4) 164 IF(lwp) WRITE(numout,*)165 162 CALL flush(numout) 166 163 … … 176 173 ! CALL SVIPC_debug(1) 177 174 178 179 ! 1.1-Define the experiment name : 175 ! Define the experiment name : 180 176 181 177 cljobnam = 'IPC' ! as $JOBNAM in namcouple 182 178 183 ! 3-Attach to shared memory pool used to exchange initial infos179 ! Attach to shared memory pool used to exchange initial infos 184 180 185 181 info = 0 … … 193 189 ENDIF 194 190 195 ! 4-Attach to pools used to exchange fields from ocean to coupler191 ! Attach to pools used to exchange fields from ocean to coupler 196 192 197 193 DO jf = 1, nfldo2c … … 203 199 END DO 204 200 205 ! 5-Attach to pools used to exchange fields from coupler to ocean201 ! Attach to pools used to exchange fields from coupler to ocean 206 202 207 203 DO jf = 1, nflxc2o … … 221 217 END DO 222 218 223 ! 6-Exchange of initial infos219 ! Exchange of initial infos 224 220 225 221 ! Write data array isend to pool READ by Oasis … … 310 306 311 307 IF( info /= clim_ok ) THEN 312 IF(lwp) WRITE( numout, *) ' cpl_init : pb init clim ' 313 IF(lwp) WRITE( numout, *) ' error code is = ', info 314 CALL abort('STOP in cpl_init') 308 IF(lwp) WRITE( numout, *) 'cpl_init : pb init clim, error code is = ', info 309 CALL abort( 'STOP in cpl_init' ) 315 310 ELSE 316 311 IF(lwp) WRITE(numout,*) 'cpl_init : init clim ok ' … … 336 331 IF(lwp) WRITE(numout,*) 'cpl_init : clim_define ok ' 337 332 338 CALL CLIM_Start 333 CALL CLIM_Start( imxtag, info ) 339 334 340 335 IF( info /= clim_ok ) THEN 341 IF(lwp) WRITE(numout,*) 'cpl_init : pb start clim ' 342 IF(lwp) WRITE(numout,*) ' error code is = ', info 343 CALL abort('stop in cpl_init') 336 IF(lwp) WRITE(numout,*) 'cpl_init : pb start clim, error code is = ', info 337 CALL abort( 'stop in cpl_init' ) 344 338 ELSE 345 339 IF(lwp) WRITE(numout,*) 'cpl_init : start clim ok ' … … 366 360 !! *** ROUTINE cpl_read *** 367 361 !! 368 !! ** Purpose : 369 !! Read and print options for the coupled run (namelist) 370 !! 371 !! ** Method : : no 362 !! ** Purpose : Read and print options for the coupled run (namelist) 363 !! 364 !! ** Method : ??? 372 365 !! 373 366 !! History : … … 491 484 492 485 493 SUBROUTINE cpl_st ep( kt )486 SUBROUTINE cpl_stp( kt ) 494 487 !!--------------------------------------------------------------------- 495 !! *** ROUTINE cpl_st ep ***488 !! *** ROUTINE cpl_stp *** 496 489 !! ***************** 497 490 !! * OASIS routine * … … 589 582 #else 590 583 alboc(:,:) = alboc(:,:) + freeze(:,:) * 0.8 591 ticoc(:,:) = ticoc(:,:) + freeze(:,:) * ( -10. 0 + rt0 )584 ticoc(:,:) = ticoc(:,:) + freeze(:,:) * ( -10.e0 + rt0 ) 592 585 #endif 593 586 … … 596 589 !--------------------------------- 597 590 598 IF( MOD( kt,nexco) == 0 ) THEN591 IF( MOD( kt, nexco ) == 0 ) THEN 599 592 600 593 ! 2.1 Average : mean coupling fields 601 DO jj = 1, jpjglo 602 DO ji = 1, jpiglo 603 zstoc (ji,jj) = 0.e0 604 zieoc (ji,jj) = 0.e0 605 zalboc(ji,jj) = 0.e0 606 zticoc(ji,jj) = 0.e0 607 END DO 608 END DO 594 zstoc (:,:) = 0.e0 595 zieoc (:,:) = 0.e0 596 zalboc(:,:) = 0.e0 597 zticoc(:,:) = 0.e0 609 598 DO jj = 1, nlcj 610 599 DO ji = 1, nlci … … 617 606 icstep = kt - nit000 + 1 618 607 619 WRITE(numout,*) ' '608 WRITE(numout,*) 620 609 WRITE(numout,*) 'STEP: Send fields to CPL with kt= ', kt 621 WRITE(numout,*) ' '610 WRITE(numout,*) 622 611 623 612 ! outputs … … 635 624 ! finalize outputs 636 625 637 CALL histclo( nidcs)626 CALL histclo( nidcs ) 638 627 639 628 ! WRITE fields for coupler with pipe technique or for last time step … … 663 652 iflmax = iflmax + 1 ! increment the number of different files 664 653 clfile(iflmax) = cpl_f_writ(jf) ! keep file name 665 ifile (iflmax) = iunmax! keep file unit for file654 ifile (iflmax) = iunmax ! keep file unit for file 666 655 ifield(jf) = ifile(iflmax) ! keep file unit for field 667 656 iunmax = iunmax-1 ! decrement unit maximum number from 99 to 98... … … 674 663 ! 675 664 DO jf = 1, nfldo2c 676 IF( jf == 1) CALL locwrite(cpl_writ(jf),zstoc , isize, ifield(jf), ierror, numout)677 IF( jf == 2) CALL locwrite(cpl_writ(jf),zieoc , isize, ifield(jf), ierror, numout)678 IF( jf == 3) CALL locwrite(cpl_writ(jf),zalboc, isize, ifield(jf), ierror, numout)679 IF( jf == 4) CALL locwrite(cpl_writ(jf),zticoc, isize, ifield(jf), ierror, numout)665 IF( jf == 1 ) CALL locwrite(cpl_writ(jf),zstoc , isize, ifield(jf), ierror, numout) 666 IF( jf == 2 ) CALL locwrite(cpl_writ(jf),zieoc , isize, ifield(jf), ierror, numout) 667 IF( jf == 3 ) CALL locwrite(cpl_writ(jf),zalboc, isize, ifield(jf), ierror, numout) 668 IF( jf == 4 ) CALL locwrite(cpl_writ(jf),zticoc, isize, ifield(jf), ierror, numout) 680 669 END DO 681 670 … … 683 672 684 673 DO jn = 1, iflmax 685 CLOSE (ifile(jn))674 CLOSE( ifile(jn) ) 686 675 END DO 687 676 688 677 ! Clim mode 689 678 IF( cchan == 'CLIM' ) THEN ! inform PVM daemon, I have finished 690 CALL CLIM_Quit (CLIM_ContPvm, info)691 IF( info /= CLIM_Ok) THEN679 CALL CLIM_Quit( CLIM_ContPvm, info ) 680 IF( info /= CLIM_Ok ) THEN 692 681 WRITE (6, *) 'An error occured while leaving CLIM. Error = ',info 693 682 ENDIF … … 696 685 ENDIF 697 686 698 ! IF last we have finished 699 700 IF (kt == nitend ) RETURN 701 702 ! 2.3 normal exchange 703 704 ! PIPE mode 705 IF( cchan == 'PIPE' ) THEN 706 707 ! Send message to pipes for CPL=atmosphere 708 709 ! DO jf = 1, nfldo2c 710 ! CALL PIPE_Model_Send(cpl_writ(jf), icstep, numout) 711 ! END DO 712 713 ! SIPC mode 714 ELSE IF( cchan == 'SIPC' ) THEN 715 716 ! Define IF a header must be encapsulated within the field brick : 717 clmodinf = 'NOT' ! as $MODINFO in namcouple 718 719 ! IF clmodinf = 'YES', define encapsulated infos to be exchanged 720 ! infos(1) = initial date 721 ! infos(2) = timestep 722 ! infos(3) = actual time 723 ! 724 ! Writing of output field SST SOSSTSST 725 ! 726 ! Index of SST in total number of fields jpfldo2a: 727 index = 1 728 ! 729 ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zstoc) 730 ! 731 ! Writing of output field Sea-Ice SOICECOV 732 ! 733 ! Index of sea-ice in total number of fields jpfldo2a: 734 index = 2 735 ! 736 ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zieoc) 737 738 ! CLIM mode 739 ELSE IF( cchan == 'CLIM' ) THEN 740 741 DO jn = 1, nfldo2c 742 743 IF (jn == 1) CALL CLIM_Export(cpl_writ(jn), icstep, zstoc , info) 744 IF (jn == 2) CALL CLIM_Export(cpl_writ(jn), icstep, zieoc , info) 745 IF (jn == 3) CALL CLIM_Export(cpl_writ(jn), icstep, zalboc, info) 746 IF (jn == 4) CALL CLIM_Export(cpl_writ(jn), icstep, zticoc, info) 747 748 IF (info /= CLIM_Ok) THEN 749 WRITE (numout,*) 'STEP : Pb giving', cpl_writ(jn), ':', jn 750 WRITE (numout,*) ' at timestep = ', icstep, 'kt = ', kt 751 WRITE (numout,*) 'Clim error code is = ',info 752 WRITE (numout,*) 'STOP in stpcpl ' 753 CALL abort(' stpcpl ') 754 ENDIF 755 END DO 687 ! IF last we have finished if not pass info to the atmosphere 688 689 IF ( kt /= nitend ) THEN 690 691 ! 2.3 normal exchange 692 693 ! PIPE mode 694 IF( cchan == 'PIPE' ) THEN 695 696 ! Send message to pipes for CPL=atmosphere 697 698 ! DO jf = 1, nfldo2c 699 ! CALL PIPE_Model_Send(cpl_writ(jf), icstep, numout) 700 ! END DO 701 702 ! SIPC mode 703 ELSE IF( cchan == 'SIPC' ) THEN 704 705 ! Define IF a header must be encapsulated within the field brick : 706 clmodinf = 'NOT' ! as $MODINFO in namcouple 707 708 ! IF clmodinf = 'YES', define encapsulated infos to be exchanged 709 ! infos(1) = initial date 710 ! infos(2) = timestep 711 ! infos(3) = actual time 712 ! 713 ! Writing of output field SST SOSSTSST 714 ! 715 ! Index of SST in total number of fields jpfldo2a: 716 index = 1 717 ! 718 ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zstoc) 719 ! 720 ! Writing of output field Sea-Ice SOICECOV 721 ! 722 ! Index of sea-ice in total number of fields jpfldo2a: 723 index = 2 724 ! 725 ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zieoc) 726 727 ! CLIM mode 728 ELSE IF( cchan == 'CLIM' ) THEN 729 730 DO jn = 1, nfldo2c 731 732 IF (jn == 1) CALL CLIM_Export(cpl_writ(jn), icstep, zstoc , info) 733 IF (jn == 2) CALL CLIM_Export(cpl_writ(jn), icstep, zieoc , info) 734 IF (jn == 3) CALL CLIM_Export(cpl_writ(jn), icstep, zalboc, info) 735 IF (jn == 4) CALL CLIM_Export(cpl_writ(jn), icstep, zticoc, info) 736 737 IF (info /= CLIM_Ok) THEN 738 WRITE (numout,*) 'STEP : Pb giving', cpl_writ(jn), ':', jn 739 WRITE (numout,*) ' at timestep = ', icstep, 'kt = ', kt 740 WRITE (numout,*) 'Clim error code is = ',info 741 WRITE (numout,*) 'STOP in stpcpl ' 742 CALL abort(' stpcpl ') 743 ENDIF 744 END DO 745 ENDIF 746 747 ! reset cumulative sst and sea-ice extend to zero 748 sstoc(:,:) = 0.e0 749 sieoc(:,:) = 0.e0 750 alboc(:,:) = 0.e0 751 ticoc(:,:) = 0.e0 756 752 ENDIF 757 758 ! reset cumulative sst and sea-ice extend to zero759 sstoc(:,:) = 0.0760 sieoc(:,:) = 0.0761 alboc(:,:) = 0.0762 ticoc(:,:) = 0.0763 753 ENDIF 764 754 765 END SUBROUTINE cpl_st ep755 END SUBROUTINE cpl_stp 766 756 767 757 #else … … 770 760 !!---------------------------------------------------------------------- 771 761 CONTAINS 772 SUBROUTINE cpl_init ! Dummy routine 762 SUBROUTINE cpl_init ! Dummy routine 763 WRITE(*,*) 'cpl_init: You should have not see this print! error?' 773 764 END SUBROUTINE cpl_init 774 SUBROUTINE cpl_st ep( kt ) ! Dummy routine775 WRITE(*,*) 'cpl_st ep: You should have not see this print! error?', kt776 END SUBROUTINE cpl_st ep765 SUBROUTINE cpl_stp( kt ) ! Dummy routine 766 WRITE(*,*) 'cpl_stp: You should have not see this print! error?', kt 767 END SUBROUTINE cpl_stp 777 768 #endif 778 769
Note: See TracChangeset
for help on using the changeset viewer.
