Changeset 473 for trunk/NEMO/OPA_SRC/SOL
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/SOL/solisl.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SOL/solisl.F90
r352 r473 39 39 40 40 !! * module variable 41 INTEGER :: numisl = 11! logical unit for island file only used41 INTEGER :: numisl ! logical unit for island file only used 42 42 ! ! here during the initialization phase 43 43 INTEGER :: & … … 248 248 249 249 IF( inilt == 0 ) THEN 250 IF(lwp) THEN 251 WRITE(numout,*) ' isldom: there is not island number: ', jnil,' while jpisl= ', jpisl 252 WRITE(numout,*) ' change parameter.h' 253 ENDIF 254 STOP 'isldom' !cr replace by nstop 250 WRITE(ctmp1,*) ' isldom: there is not island number: ', jnil,' while jpisl= ', jpisl 251 CALL ctl_stop( ctmp1, ' change par_oce' ) 252 255 253 ENDIF 256 254 … … 381 379 382 380 IF( ip > jpnisl ) THEN 383 IF(lwp) THEN 384 WRITE(numout,*) ' isldom: the island ',jnil,' has ', & 385 mnisl(0,jnil),' grid-points, while jpnisl= ', jpnisl,ip 386 WRITE(numout,*) ' change parameter.h' 387 ENDIF 388 STOP 'isldom' !cr => nstop 381 WRITE(ctmp1,*) ' isldom: the island ',jnil,' has ', & 382 mnisl(0,jnil),' grid-points, while jpnisl= ', jpnisl,ip 383 CALL ctl_stop( ctmp1, ' change par_oce.h' ) 389 384 ENDIF 390 385 … … 407 402 408 403 IF( inilt /= jpij+1 ) THEN 409 IF(lwp) THEN 410 WRITE(numout,*) ' isldom: there is at least one more ', & 404 WRITE(ctmp1,*) ' isldom: there is at least one more ', & 411 405 'island in the domain and jpisl=', jpisl 412 WRITE(numout,*) ' change parameter.h' 413 ENDIF 414 STOP 'isldom' 406 CALL ctl_stop( ctmp1, ' change par_oce.h' ) 415 407 ENDIF 416 408 … … 562 554 !! * Modules used 563 555 USE ioipsl 556 USE iom 564 557 565 558 !! * Local declarations 566 INTEGER :: ji, jj, jni, jnj, jn, jl ! dummy loop indices 567 INTEGER :: itime, ibvar, ios ! temporary integers 568 LOGICAL :: llog 569 CHARACTER (len=32) :: clname 570 CHARACTER (len=8 ) :: clvnames(100) 571 REAL(wp), DIMENSION(1) :: zdept 572 REAL(wp), DIMENSION(jpi,jpj) :: zlamt, zphit 559 INTEGER :: ji, jj, jni, jnj, jl ! dummy loop indices 560 INTEGER :: ios ! temporary integers 561 INTEGER :: & 562 inum ! temporary logical unit 573 563 REAL(wp), DIMENSION(jpi,jpj,2) :: zwx 574 564 REAL(wp), DIMENSION(jpisl*jpisl) :: ztab … … 580 570 581 571 ! Lecture 582 zlamt(:,:) = 0. 583 zphit(:,:) = 0. 584 zdept(1) = 0. 585 itime = 0 586 clvnames=" " 587 clname = 'islands' 588 CALL ioget_vname(numisl, ibvar, clvnames) 589 IF(lwp) WRITE(numout,*) clvnames 590 ios=0 591 DO jn=1,100 592 IF(clvnames(jn) == 'aisl') ios=1 593 END DO 594 IF( ios == 0 ) go to 110 595 596 CALL restget( numisl, 'aisl' , jpisl, jpisl, 1, 0, llog, aisl ) 597 CALL restget( numisl, 'aislm1', jpisl, jpisl, 1, 0, llog, aislm1 ) 598 CALL restclo( numisl ) 599 ! Control print 600 IF(lwp) THEN 601 WRITE(numout,*) 602 WRITE(numout,*)' islmat: lecture aisl/aislm1 in numisl done' 603 WRITE(numout,*)' ~~~~~~' 604 WRITE(numout,*) 605 WRITE(numout,*) ' island matrix : ' 606 WRITE(numout,*) 607 608 DO jnj = 1, jpisl 609 WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl ) 610 END DO 611 612 WRITE(numout,*) 613 WRITE(numout,*) ' inverse of the island matrix' 614 WRITE(numout,*) 615 616 DO jnj = 1, jpisl 617 WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1,jpisl ) 618 END DO 619 ENDIF 620 621 RETURN 622 623 110 CONTINUE 624 572 CALL iom_open ( 'islands', inum ) 573 ios = iom_varid( inum, 'aisl' ) 574 IF( ios > 0 ) THEN 575 576 CALL iom_get( inum, jpdom_unknown, 'aisl' , aisl ) 577 CALL iom_get( inum, jpdom_unknown, 'aislm1', aislm1 ) 578 CALL iom_close( inum ) 579 ! Control print 580 IF(lwp) THEN 581 WRITE(numout,*) 582 WRITE(numout,*)' islmat: lecture aisl/aislm1 in numisl done' 583 WRITE(numout,*)' ~~~~~~' 584 WRITE(numout,*) 585 WRITE(numout,*) ' island matrix : ' 586 WRITE(numout,*) 587 588 DO jnj = 1, jpisl 589 WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl ) 590 END DO 591 592 WRITE(numout,*) 593 WRITE(numout,*) ' inverse of the island matrix' 594 WRITE(numout,*) 595 596 DO jnj = 1, jpisl 597 WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1,jpisl ) 598 END DO 599 ENDIF 600 601 CALL restclo(numisl) 602 603 ELSE 604 605 CALL iom_close( inum ) 625 606 626 607 ! II. Island matrix computation … … 707 688 CALL restput( numisl, 'aislm1', jpisl, jpisl, 1, 0, aislm1 ) 708 689 CALL restclo( numisl ) 690 691 ENDIF 709 692 710 693 END SUBROUTINE isl_mat … … 744 727 !! * Modules used 745 728 USE ioipsl 729 USE iom 746 730 USE solpcg 747 731 USE solfet … … 751 735 LOGICAL :: llog, llbon 752 736 CHARACTER (len=10) :: clisl 753 CHARACTER (len=32) :: clname, clname2 754 INTEGER :: ji, jj, jni, jii, jnp, je ! dummy loop indices 737 CHARACTER (len=32) :: clname = 'islands' 738 INTEGER :: & 739 inum ! temporary logical unit 740 INTEGER :: ji, jj, jni, jii, jnp ! dummy loop indices 755 741 INTEGER :: iimlu, ijmlu, inmlu, iju 756 742 INTEGER :: ii, ij, icile, icut, inmax, indic 757 INTEGER :: itime , ie743 INTEGER :: itime 758 744 REAL(wp) :: zepsr, zeplu, zgwgt 759 REAL(wp) :: zep(jpisl), z lamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4)745 REAL(wp) :: zep(jpisl), zdept(1), zprec(4) 760 746 REAL(wp) :: zdate0, zdt 761 747 REAL(wp) :: t2p1(jpi,1,1) … … 779 765 inmlu = 0 780 766 zeplu = 0. 781 zlamt(:,:) = 0. 782 zphit(:,:) = 0. 783 zdept(1) = 0. 784 itime = 0 767 785 768 clname = 'islands' 786 ie=1 787 DO je = 1, 32 788 IF( clname(je:je) /= ' ' ) ie = je 789 END DO 790 clname2 = clname(1:ie)//".nc" 791 INQUIRE( FILE=clname2, EXIST=llbon ) 769 770 INQUIRE( FILE=clname, EXIST=llbon ) 792 771 ! islands FILE does not EXIST : icut=999 793 772 IF( llbon ) THEN 773 794 774 ! island FILE is present 795 CALL restini(clname,jpi,jpj,zlamt,zphit,1,zdept, & 796 & 'NONE',itime,zdate0,zdt,numisl,domain_id=nidom) 797 CALL restget(numisl,'PRECISION',1,1,4,0,llog,zprec) 775 776 CALL iom_open (clname, inum ) 777 CALL iom_get( inum, jpdom_unknown, 'PRECISION', zprec ) 778 798 779 iimlu = NINT( zprec(1) ) 799 780 ijmlu = NINT( zprec(2) ) … … 803 784 IF( iimlu /= jpi .OR. ijmlu /= jpj .OR. inmlu /= jpisl ) THEN 804 785 icut = 999 805 CALL restclo(numisl)806 786 ELSE 807 787 DO jni = 1, jpisl … … 813 793 WRITE(clisl,'("island",I3)') jni 814 794 ENDIF 815 CALL restget(numisl,clisl,jpi,jpj,1,0,llog, bsfisl(:,:,jni))795 CALL iom_get( inum, jpdom_local, clisl, bsfisl(:,:,jni)) 816 796 END DO 817 797 ENDIF … … 819 799 ! islands FILE does not EXIST : icut=999 820 800 icut = 999 821 CALL restclo(numisl) 822 ENDIF 823 801 ENDIF 802 803 CALL iom_close( inum ) 804 824 805 ! the read precision is not the required one : icut=888 825 806 IF( zeplu > epsisl ) THEN 826 807 icut = 888 827 CALL restclo(numisl)828 808 ENDIF 829 809 … … 1096 1076 zprec(3) = FLOAT(jpisl) 1097 1077 IF(lwp) WRITE(numout,*) clname 1078 zdept(1) = 0. 1079 itime = 0 1098 1080 CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1, zdept, & 1099 1081 & clname, itime, zdate0, rdt, numisl, domain_id=nidom ) … … 1150 1132 END DO 1151 1133 CALL restclo(numisl) 1152 nstop = nstop + 11134 CALL ctl_stop( ' ' ) 1153 1135 ENDIF 1154 1136
Note: See TracChangeset
for help on using the changeset viewer.
